home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / AlphaLite.6.52 / Tcl / Modes / htmlUtils.tcl < prev    next >
Encoding:
Text File  |  1997-03-04  |  85.0 KB  |  2,684 lines  |  [TEXT/ALFA]
  1. #===============================================================================
  2. #
  3. #     htmlUtils.tcl (called from html.tcl)
  4. #
  5. #    Part of HTML mode 1.4.1
  6. #
  7. #     HTML Utilities
  8. #
  9. #    Copyright 1996, 1997 by Johan Linde <jl@theophys.kth.se>.
  10. #    This software may be used freely, and distributed freely, as long as 
  11. #    the receiver is not obligated in any way by receiving it.
  12. #
  13. #    If you make improvements to this file, please share them!
  14. #
  15. #===============================================================================
  16.  
  17. #
  18. # Mark file
  19. #
  20. proc parseFuncsHTML {} {
  21.     return [htmlMarkFile2 0]
  22. }
  23.  
  24. proc HTMLMarkFile {} {
  25.     htmlMarkFile2 1
  26.     message "Marks set."
  27. }
  28.  
  29. proc htmlMarkFile2 {markfile} {
  30.     set pos 0
  31.     set exp {<[Hh][1-6][^>]*>}
  32.     set exp2 {</[Hh][1-6]>}
  33.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp $pos} rs] && 
  34.     ![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp2 [lindex $rs 1]} res]} {
  35.         set start [lindex $rs 0]
  36.         set end [lindex $res 1]
  37.         set text [getText $start $end]
  38.         # Remove tabs and returns from text.
  39.         regsub -all "\[\t\r\]+" $text " " text
  40.         set headtext ""
  41.         # remove all tags from text
  42.         while {1} {
  43.             set lt [string first < $text ]
  44.             if {$lt < 0} { break }
  45.             if {$lt > 0} { append headtext [string range $text 0 [expr $lt - 1]] }
  46.             set text [string range $text $lt end]
  47.             set gt [string first > $text]
  48.             if {$gt < 0} { break }
  49.             set text [string range $text [expr $gt + 1] end]
  50.         }
  51.         # Set mark only on one line.
  52.         if {$end > [nextLineStart $start]} {
  53.             set end [expr [nextLineStart $start] - 1]
  54.         }
  55.         
  56.         set indlevel [getText [expr $start + 2] [expr $start + 3]]
  57.  
  58.         if {$indlevel > 0 && $indlevel < 7} {
  59.             set lab [string range "       " 2 $indlevel]
  60.             append lab $lab $indlevel " " $headtext
  61.             # Cut the menu item if it's longer than 30 letters, not to make it too long.
  62.             if {[string length $lab] > 30} {
  63.                 set lab "[string range $lab 0 29]…"
  64.             }
  65.             if {$markfile} {
  66.                 setNamedMark $lab $start $start $end
  67.             } else {
  68.                 lappend parse $lab [lineStart $start]
  69.             }
  70.         }
  71.         set pos $end
  72.     }
  73.     if {!$markfile} {return $parse}
  74. }
  75.  
  76. # Opens a file in the home page folder, if clicked on a link to a text file.
  77. # If the file doesn't exist, it can be opened in a new empty window, and automatically
  78. # saved in the right place.
  79. proc HTMLDblClick {from to} {
  80.     global htmlURLAttr HTMLmodeVars filepats
  81.     
  82.     # Build regular expressions with URL attrs.
  83.     set exp "("
  84.     foreach attr $htmlURLAttr {
  85.         append exp "$attr|"
  86.     }
  87.     set exp [string trimright $exp |]
  88. #     append exp ")\"?(\[^ \\t\\r\\n\">\]+)\"?"
  89.     append exp ")(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  90.  
  91.     # Check if user clicked on a link.
  92.     if {![catch {search -s -f 0 -r 1 -i 1 -m 0 $exp $from} res] && [lindex $res 1] > $from} {
  93.         # Get path to this window.
  94.         if {![string length [set thisURL [htmlThisFilePath 1]]]} {return}
  95.         # Get path to link.
  96.         regexp -nocase $exp [getText [lindex $res 0] [lindex $res 1]] dum1 dum2 linkTo
  97.         set linkTo [htmlURLunEscape [string trim $linkTo \"]]
  98.         # Anchors points to file itself if no BASE. (BASE if [llength $thisURL] > 4)
  99.         if {[string index $linkTo 0] == "#" && [llength $thisURL] > 4} {return}
  100.         if {[catch {lindex [htmlPathToFile [lindex $thisURL 0] [lindex $thisURL 1] [lindex $thisURL 2] [lindex $thisURL 3] $linkTo] 0} linkToPath]} {
  101.             if {$linkToPath == ""} {
  102.                 message "Link not well-defined."
  103.             } else {
  104.                 message "Link points to $linkToPath. Doesn't map to a file on the disk."
  105.             }
  106.             return
  107.         }
  108.         # Does the file exist? 
  109.         if {[file exists $linkToPath] && ![file isdirectory $linkToPath]} {
  110.             # Is it a text file?
  111.             if {[htmlIsTextFile $linkToPath message]} {
  112.                 edit -c $linkToPath
  113.             }
  114.         } else {
  115.             set isAnHtmlFile 0
  116.             foreach suffix $filepats(HTML) {
  117.                 if {[string match $suffix $linkToPath]} {set isAnHtmlFile 1}
  118.             }
  119.             if {(![file exists $linkToPath] && !$isAnHtmlFile) || [file isdirectory $linkToPath] ||
  120.             ![regexp {[^:]+} $linkToPath disk] || ![file exists $disk:]} {
  121.                 message "Cannot open [file tail $linkToPath]."
  122.             } else {
  123.                 set htmlFile [file tail $linkToPath]
  124.                 if {[lindex [dialog -w 350 -h 140 -t "The file '$htmlFile' does not exist.\
  125.                 Do you want to open a new empty window with this name?\
  126.                 It will automatically be saved in the right place,\
  127.                 and if necessary, new folders will be created."  10 10 340 100 \
  128.                 -b Yes 20 110 85 130 -b No 115 110 180 130] 1]} {return}
  129.                 # Create a new file and open it.
  130.                 foreach p [split [file dirname $linkToPath] :] {
  131.                     append path "$p:"
  132.                     # make new folders if needed.
  133.                     if {![file exists $path]} {
  134.                         mkdir $path
  135.                     } elseif {![file isdirectory $path]} {
  136.                         alertnote "Cannot make a new folder '[file tail $path]'.\
  137.                         There is already a file with the same name."
  138.                         return
  139.                     }
  140.                 }
  141.                 append path "$htmlFile"
  142.                 # create an empty file.
  143.                 set fid [open $path w]
  144.                 # I suppose it's best to close it, too.
  145.                 close $fid
  146.                 edit $path
  147.             }
  148.         }
  149.     } elseif {![catch {search -s -f 0 -r 1 -i 1 -m 0 {FILE=\"[^\"]+\"} $from} res] && [lindex $res 1] > $from} {
  150.         regexp -nocase {FILE=\"([^\"]+)\"} [getText [lindex $res 0] [lindex $res 1]] dum fil
  151.         set fil [htmlUnQuote $fil]
  152.         if {[file exists $fil]} {
  153.             edit -c $fil
  154.         } else {
  155.             message "File not found."
  156.         }
  157.     } elseif {![htmlRevealColor 1]} {
  158.         message "You must click on a URL, include tag, or a color."
  159.     }
  160. }
  161.  
  162. #
  163. # return positions of tags of including elements, as a list of 5 elements --
  164. # openstart openend closestart closeend elementname.
  165. # Elements without a closing tag are ignored.
  166. # args: point to start search backward from; point which must be enclosed
  167. #
  168. # if any problem, return just {0}
  169. #
  170. proc htmlGetContainer {curPos inclPos} {
  171.  
  172.     set startPos $curPos
  173.     set startPos2 $inclPos
  174.     set searchFinished 0
  175.     message "Searching for enclosing tags…"
  176.     while {!$searchFinished} {
  177.         # find first tag
  178.         set isStartTag 0
  179.         while {!$isStartTag} {
  180.             if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  181.                 message ""
  182.                 return {0}
  183.             }
  184.             set tag1start [lindex $res 0]
  185.             set tag1end   [lindex $res 1]
  186.             # get element name
  187.             if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  188.                 message ""
  189.                 return {0}
  190.             }
  191.             # is this a closing tag?
  192.             if {[string index $tag 0] != "/"} { set isStartTag 1}
  193.             set startPos [expr $tag1start - 1]
  194.         }
  195.         # find closing tag
  196.         set res [htmlGetClosing $tag $tag1end]
  197.         
  198.         set tag2start [lindex $res 0]
  199.         set tag2end   [lindex $res 1]
  200.         # If container enclosed along with us, or there is no closing tag,
  201.         # continue searching.
  202.         if {![llength $res] || $tag2end < $inclPos} {
  203.             set startPos [expr $tag1start - 1]
  204.         } else {
  205.             set Container "$tag1start $tag1end $tag2start $tag2end" 
  206.             set searchFinished 1
  207.         }
  208.     }
  209.     
  210.     message ""
  211.     return [concat $Container [string toupper $tag]]
  212. }
  213.  
  214.  
  215. #
  216. # return position an opening tag if the first element to the left
  217. # of startPos is an element with only an opening tag, as a list of 3 elements --
  218. # openstart openend elementname.
  219. #
  220. # if any problem, return empty string
  221. #
  222.  
  223. proc htmlGetOpening {startPos} {
  224.     
  225.     while {1} {
  226.         if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  227.             return
  228.         }
  229.         set tag1start [lindex $res 0]
  230.         set tag1end   [lindex $res 1]
  231.         # get element name
  232.         if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  233.             return
  234.         }
  235.         # is this a closing tag?
  236.         if {[string index $tag 0] == "/"} {return}
  237.         # comment?
  238.         if {[string range $tag 0 2] != "!--"} {break}
  239.         set startPos [expr $tag1start - 1]
  240.     }
  241.     
  242.     # find closing tag
  243.     set res [htmlGetClosing $tag $tag1end]
  244.     
  245.     if {![llength $res] } {
  246.         return "$tag1start $tag1end [string toupper $tag]"
  247.     } else {
  248.         return
  249.     }
  250.     
  251. }
  252.  
  253. proc htmlGetClosing {tag sPos} {
  254.     set x </${tag}>
  255.     set sPos2 $sPos
  256.     while {1} {
  257.         set res [search -s -f 1 -r 1 -i 1 -m 0 -n $x $sPos]
  258.         # Found any closing tag.
  259.         if {![llength $res]} {break}
  260.         # Look for another opening tag of the same element.
  261.         set y "<${tag}(\[ \\t\\r\]+|>)"
  262.         set res2 [search -s -f 1 -r 1 -i 1 -m 0 -n $y $sPos2]
  263.         # Is it further away than the closing tag.
  264.         if {![llength $res2] || [lindex $res2 0] > [lindex $res 0]} {break}
  265.         # If not, find the next closing tag.
  266.         set sPos [lindex $res 1]
  267.         set sPos2 [lindex $res2 1]
  268.     }
  269.     return $res
  270. }
  271.  
  272. # Change choice of an attribute with pre-defined choices.
  273. proc htmlChangeChoice {} {
  274.     set pos [expr [getPos] - 1]
  275.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  276.     [lindex $res 1] < $pos || 
  277.     ![regexp {<([^ \t\r>]+)} [getText [lindex $res 0] [lindex $res 1]] tmp tag] ||
  278.     [catch {search -s -f 0 -r 1 -i 0 -m 0 {[ \t\r]+[^=]+=\"?[^\" \t\r>]+\"?} $pos} res1] ||
  279.     [lindex $res1 1] < $pos ||
  280.     ![regexp {([^=]+=)(([^\" \t\r>]+)|(\"[^\" \t\r]+\"))} [getText [lindex $res1 0] [lindex $res1 1]] tmp attr choice]} {
  281.         beep
  282.         message "Current position is not at an attribute with choices."
  283.         return
  284.     }
  285.     set pos0 [expr [lindex $res1 0] + [string length $attr]]
  286.     set pos1 [expr $pos0 + [string length $choice]]
  287.     set choice [string trim $choice \"]
  288.     set tag [string toupper $tag]
  289.     if {$tag == "INPUT"} {
  290.         if {![regexp -nocase {type=(([^\" \t\r>]+)|(\"[^\" \t\r]+\"))} [getText [lindex $res 0] [lindex $res 1]] tmp tag]} {
  291.             beep
  292.             message "Current position is not at an attribute with choices."
  293.             return
  294.         }
  295.         set tag [string trim [string toupper $tag] \"]
  296.     }
  297.     if {$tag == "LI"} {
  298.         set ltype [htmlFindList]
  299.         if {$ltype == "UL"} {
  300.             set tag "LI IN UL"
  301.         } elseif {$ltype == "OL"} {
  302.             set tag "LI IN OL"
  303.         }            
  304.     }
  305.     set attr [string trim [string toupper $attr]]
  306.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set choice [string toupper $choice]}
  307.     set choices [htmlGetChoices $tag]
  308.     foreach c $choices {
  309.         if {[string match "${attr}*" $c]} {
  310.             lappend matches [string range $c [string length $attr] end]
  311.         }    
  312.     }
  313.     if {![info exists matches]} {
  314.         beep
  315.         message "Current position is not at an attribute with choices."
  316.         return
  317.     }
  318.     if {[set this [lsearch -exact $matches $choice]] < 0} {set this 0}
  319.     incr this
  320.     if {$this == [llength $matches]} {set this 0}
  321.     set this [lindex $matches $this]
  322.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set this [htmlSetCase $this]}
  323.     replaceText $pos0 $pos1 "\"$this\""
  324. }
  325.  
  326. # Asks for a file and returns the file name including the relative path from
  327. # current window, provided both are in the home page folder. Otherwise an empty 
  328. # string is returned.
  329. proc htmlGetFile {} {
  330.         
  331.     # get path to this window.    
  332.     if {![string length [set this [htmlThisFilePath 0]]]} {return}
  333.     
  334.     # Get the file to link to.
  335.     if {[catch {getfile "Select file to link to."} linkFile]} {
  336.         return 
  337.     }
  338.     # Get URL for this file?
  339.     set link [htmlBASEfromPath $linkFile]
  340.     if {[lindex $link 4] == "4"} {
  341.         alertnote "You can't link to a file in an include folder."
  342.         return
  343.     }
  344.     if {[lindex $this 0] == [lindex $link 0]} {
  345.         set linkTo [htmlRelativePath "[lindex $this 1][lindex $this 2]" "[lindex $link 1][lindex $link 2]"]
  346.     } else {
  347.         set linkTo [join [lrange $link 0 2] ""]
  348.     }
  349.     getFileInfo $linkFile arr
  350.     if {$arr(type) == "GIFf"} {
  351.         set widthheight [htmlGIFWidthHeight $linkFile]
  352.     } elseif {$arr(type) =="JPEG" || $arr(type) == "JFIF"} {
  353.         set widthheight [htmlJPEGWidthHeight $linkFile]
  354.     } else {
  355.         set widthheight ""
  356.     }
  357.     # Add URL to cache.
  358.     htmlAddToCache URLs $linkTo
  359.     return [list $linkTo $widthheight]
  360. }
  361.  
  362.  
  363. # Check that links are valid.
  364. proc htmlCheckLinks {where} {
  365.     global HTMLmodeVars
  366.         
  367.     # Save all open window?
  368.     if {$where != "Window" && 
  369.     [htmlAllSaved "-c {Save all open windows before checking links?}"] == "cancel"} { return}
  370.     set filebase 0
  371.     if {$where == "File"} {
  372.         if {[catch {getfile "Select file to scan."} files]} {return}
  373.         # Is this a text file?
  374.         if {![htmlIsTextFile $files alertnote]} {return}
  375.         set base [htmlBASEfromPath $files]
  376.         if {$HTMLmodeVars(useBigBrother)} {htmlBigBrother "$files"; return}
  377.         set path [lindex $base 1]
  378.         set homepage [lindex $base 3]
  379.         set isinfld [lindex $base [expr 3 + [lindex $base 4] / 2]]
  380.         set base [lindex $base 0]
  381.         if {$base == "file:///"} {set filebase [string length "[file dirname $files]:"]}
  382.         # Make it a list in case it contains spaces.
  383.         set files [list $files]
  384.     } elseif {$where == "Window"} {
  385.         set files [stripNameCount [lindex [winNames -f] 0]]
  386.         if {![file exists $files]} {
  387.             if {[lindex [dialog -w 200 -h 70 -t "You must save the window." 10 10 390 30  \
  388.             -b Save 20 40  85 60 \
  389.             -b Cancel 110 40 175 60] 1]} {
  390.                 return
  391.             }
  392.             if {![catch {saveAs "Untitled.html"}]} {
  393.                 set files [stripNameCount [lindex [winNames -f] 0]]
  394.             } else {
  395.                 return 
  396.             }
  397.         } else {
  398.             if {[winDirty] && [askyesno "Save window?"] == "yes"} {save}
  399.         }
  400.         set base [htmlBASEfromPath $files]
  401.         if {$HTMLmodeVars(useBigBrother)} {htmlBigBrother "$files"; return}
  402.         set path [lindex $base 1]
  403.         set homepage [lindex $base 3]
  404.         set isinfld [lindex $base [expr 3 + [lindex $base 4] / 2]]
  405.         set base [lindex $base 0]
  406.         if {$base == "file:///"} {set filebase [string length "[file dirname $files]:"]}
  407.         set files [list $files]
  408.     } elseif {$where == "Folder"} {
  409.         if {[catch {htmlGetDir "Folder to scan."} folder]} {return}
  410.         set base [htmlBASEfromPath $folder]
  411.         set subFolders [expr ![string compare yes [askyesno "Check files in subfolders?"]]]
  412.         if {$subFolders && ![set subFolders [expr ![htmlContainHpFolder $folder]]] &&
  413.         [lindex [dialog -w 410 -h 135 -t "The folder '[file tail $folder]' contains a\
  414.         home page folder or an include folder, but is itself not inside one. You can't\
  415.         simultaneously check links both inside and outside home page or include folders.\
  416.         Sorry!\rBut\
  417.         you can still check this folder and skip the subfolders." 10 10 400 90\
  418.         -b Check 20 105 85 125 -b Cancel 110 105 175 125] 1]} {return}
  419.         if {$HTMLmodeVars(useBigBrother)} {htmlBigBrother "$folder:" $subFolders; return}
  420.         set path [lindex $base 1]
  421.         set homepage [lindex $base 3]
  422.         set isinfld [lindex $base [expr 3 + [lindex $base 4] / 2]]
  423.         set base [lindex $base 0]
  424.         if {$base == "file:///"} {set filebase [string length "$folder:"]}
  425.         if {$subFolders} {
  426.             set files [htmlAllHTMLfiles $folder]
  427.         } else {
  428.             set files [htmlGetHTMLfiles $folder]
  429.         }
  430.     } else {
  431.         # Check that a home page is defined.
  432.         if {![htmlIsThereAHomePage]} {return}
  433.         if {[catch {htmlWhichHomePage "check links in"} hp]} {return}
  434.         set homepage [lindex $hp 0]
  435.         set isinfld $homepage
  436.         if {$HTMLmodeVars(useBigBrother)} {htmlBigBrother "$homepage:" 1; return}
  437.         set files [htmlAllHTMLfiles $homepage]
  438.         set base [lindex $hp 1]
  439.         set path [lindex $hp 2]
  440.     }
  441.     htmlScanFiles $files $base $path $homepage $isinfld 1 $filebase
  442. }
  443.  
  444.  
  445. proc htmlBigBrother {path {searchSubFolder 0}} {
  446.     global HTMLmodeVars
  447.     # define url mapping
  448.     set urlmap [htmlURLmap]
  449.     # launches Big Brother
  450.     if {[catch {file tail [launchBackAppl Bbth]} name]} {
  451.         alertnote "Could not find or launch Big Brother."
  452.         return
  453.     }
  454.     
  455.     # Read all settings.
  456.     set allSettings [AEBuild -r $name core getd ---- "obj{want:type('reco'),from:null(),form:'prop',seld:type('allS')}"]
  457.     set allSettings [string range $allSettings 17 [expr [string length $allSettings] - 2]]
  458.     
  459.     if {[regexp {mapS:} $allSettings]} {
  460.         # Change settings
  461.         if {!$HTMLmodeVars(useBBoptions)} {
  462.             AEBuild $name core setd "----" "obj{want:type('bool'),from:null(),form:'prop',seld:type('Loly')}" "data" "bool(«0$HTMLmodeVars(ignoreRemote)»)"
  463.             AEBuild $name core setd "----" "obj{want:type('bool'),from:null(),form:'prop',seld:type('Roly')}" "data" "bool(«0$HTMLmodeVars(ignoreLocal)»)"
  464.         }        
  465.         AEBuild $name core setd "----" "obj{want:type('bool'),from:null(),form:'prop',seld:type('Sfld')}" "data" "bool(«0$searchSubFolder»)"
  466.         AEBuild $name core setd "----" "obj{want:type('mapG'),from:null(),form:'prop',seld:type('mapS')}" "data" "\[$urlmap\]"
  467.     } else {
  468.         alertnote "Cannot change the settings in Big Brother. You need Big Brother 1.1 or later."
  469.     }
  470.     # Sends a file or folder to be opened.
  471.     sendOpenEvent noReply $name $path
  472.  
  473.     if {[regexp {mapS:} $allSettings]} {
  474.         # Restore the settings.
  475.         AEBuild $name core setd "----" "obj{want:type('reco'),from:null(),form:'prop',seld:type('allS')}" "data" $allSettings
  476.     }
  477.     if {$HTMLmodeVars(checkInFront)} {switchTo $name}
  478. }
  479.  
  480.  
  481. # Moves files from one folder to another and update all links to the moved files
  482. # as well as all links in the moved files.
  483. proc htmlMoveFiles {} {
  484.     global HTMLmodeVars
  485.     
  486.     # Check that a home page is defined.
  487.     if {![htmlIsThereAHomePage]} {return}
  488.     
  489.     if {[htmlAllSaved "{All windows must be saved before you can moves files. Save?}"] == "no"} {return}
  490.  
  491.     # Get folder to move from.
  492.     if {[catch {htmlGetDir "Move from."} fromFolder]} {return}
  493.     set base [htmlBASEfromPath $fromFolder]
  494.     # Is this folder in a home page folder?
  495.     if {[lindex $base 0] == "file:///"} {
  496.         alertnote "'[file tail $fromFolder]' is not in a home page folder or an include folder."
  497.         return 
  498.     }
  499.     set fromPath [lindex $base 1]
  500.     set homepage [lindex $base 3]
  501.     set fromBase [lindex $base 0]
  502.     set isInInclFldr [lindex $base 4]
  503.     set inclFld [lindex $base 5]
  504.     
  505.     # Check that the corresponding include or home page folder exists.
  506.     if {$isInInclFldr} {
  507.         if {![file isdirectory $homepage]} {
  508.             alertnote "Could not find the corresponding home page folder for\
  509.             ${fromBase}$fromPath. Fix that and try again."
  510.             htmlHomePages "${fromBase}$fromPath"
  511.             return
  512.         }
  513.     } elseif {$inclFld != "" && ![file isdirectory $inclFld]} {
  514.         alertnote "Could not find the corresponding include folder for\
  515.         ${fromBase}$fromPath. Fix that and try again."
  516.         htmlHomePages "${fromBase}$fromPath"
  517.         return
  518.     }
  519.     
  520.         
  521.     # Get files to move.
  522.     set files [glob -nocomplain "$fromFolder:*"]
  523.     foreach f $files {
  524.         if {![file isdirectory $f]} {
  525.             lappend filelist [file tail $f]
  526.         }
  527.     }
  528.     if {![info exists filelist]} {
  529.         alertnote "Empty folder."
  530.         return
  531.     }
  532.     
  533.     if {[catch {listpick -p "Select files to move." -l $filelist} movefiles] || \
  534.     ![string length $movefiles]} {return}
  535.     
  536.     # Get folder to move to.
  537.     if {[catch {htmlGetDir "Move to."} toFolder]} {return}
  538.     if {$fromFolder == $toFolder} {
  539.         alertnote "This is the same folder as you moved from."
  540.         return
  541.     }
  542.     # Is this folder in the same home page folder?
  543.     if {!$isInInclFldr && ![string match "${homepage}:*" "$toFolder:"] ||
  544.     $isInInclFldr && ![string match "${inclFld}:*" "$toFolder:"]} {
  545.         set msg {"home page" "" "" "" "include"}
  546.         alertnote "'[file tail $toFolder]' is not in the same [lindex $msg $isInInclFldr] folder."
  547.         return
  548.     }
  549.     
  550.     # Move the files.
  551.     foreach f $movefiles {
  552.         if {[file exists "$toFolder:$f"]} {
  553.             if {[askyesno "Replace '$f' in folder '[file tail $toFolder]'?"] == "yes"} {
  554.                 removeFile "$toFolder:$f"
  555.             } else {
  556.                 continue
  557.             }
  558.         }
  559.         set reo 0
  560.         foreach w [winNames -f] {
  561.             if {[stripNameCount $w] == "$fromFolder:$f"} {
  562.                 alertnote "'[file tail $w]' must be closed before it can be moved. It will be reopened again."
  563.                 bringToFront $w
  564.                 killWindow
  565.                 set reo 1
  566.             }
  567.         }
  568.         if {[catch {mv "$fromFolder:$f" "$toFolder:$f"}] && ![file exists "$toFolder:$f"]} {
  569.             alertnote "Could not move $f. An error occured."
  570.             if {$reo} {lappend reOpen "$fromFolder:$f"}
  571.         } else {
  572.             lappend movedFiles "$fromFolder:$f"
  573.             lappend movedFiles2 "$toFolder:$f"
  574.             if {$reo} {lappend reOpen "$toFolder:$f"}
  575.         }
  576.     }
  577.     
  578.     if {[info exists movedFiles] && $isInInclFldr} {
  579.         if {[lindex [dialog -w 400 -h 70 -t "Files have been moved. Update links?" \
  580.         10 10 290 30 -b Update 20 40 85 60 -b Cancel 105 40 170 60] 0]} {
  581.             set changed ""
  582.             set num [htmlUpdateAfterMove2 $movedFiles $movedFiles2 $fromBase $fromPath $inclFld]
  583.             set x [htmlUpdateAfterMove3 $movedFiles $movedFiles2 $homepage]
  584.             incr num [lindex $x 0]
  585.             set changed [concat $changed [lindex $x 1]]
  586.         }
  587.     } elseif {[info exists movedFiles]} {
  588.         set box " -t {Files have been moved. Update links?} 10 10 390 30"
  589.         if {$inclFld != ""} {
  590.             append box " -r {Update both home page folder and include folder} 1 10 40 390 55 \
  591.             -r {Update only home page folder} 0 10 60 390 75 -r {Update only include folder} 0 10 80 390 95"
  592.             set he 140
  593.         } else {
  594.             set he 70
  595.         }
  596.         append box " -b Update 20 [expr $he - 30] 85 [expr $he - 10] -b Cancel 105 [expr $he - 30] 170 [expr $he - 10]"
  597.         set values [eval [concat dialog -w 400 -h $he $box]]
  598.         if {$inclFld != "" && ([lindex $values 0] || [lindex $values 1]) && [lindex $values 3] ||
  599.         $inclFld == "" && [lindex $values 0]} {
  600.             set x [htmlUpdateAfterMove $movedFiles $movedFiles2 $fromBase $fromPath $homepage $homepage]
  601.             set num [lindex $x 0]
  602.             set changed [lindex $x 1]
  603.             incr num [htmlUpdateAfterMove2 $movedFiles $movedFiles2 $fromBase $fromPath $homepage]
  604.         }
  605.         if {$inclFld != "" && ([lindex $values 0] || [lindex $values 2]) && [lindex $values 3]} {
  606.             set x [htmlUpdateAfterMove $movedFiles $movedFiles2 $fromBase $fromPath $homepage $inclFld]
  607.             incr num [lindex $x 0]
  608.             set changed [concat $changed [lindex $x 1]]
  609.         }    
  610.     }
  611.     
  612.     catch {message "$num files has been modified including the ones moved."}
  613.  
  614.     if {[info exists reOpen] && [askyesno "Reopen previously closed windows?"] == "yes"} {
  615.         foreach r $reOpen {
  616.             edit $r
  617.         }
  618.     }
  619.     
  620.     if {[llength $changed] && [askyesno "Update affected windows?"] == "yes"} {
  621.         foreach r $changed {
  622.             bringToFront $r
  623.             revert
  624.         }
  625.     }
  626. }
  627.  
  628. # Updates links to moved files.
  629. proc htmlUpdateAfterMove {movedFiles movedFiles2 fromBase fromPath homepage isinfld} {
  630.     global htmlURLAttr
  631.     
  632.     set allfiles [htmlAllHTMLfiles $isinfld]
  633.     foreach f $movedFiles2 {
  634.         if {[set i [lsearch -exact $allfiles $f]] >= 0} {
  635.             set allfiles [lreplace $allfiles $i $i]
  636.         }
  637.     }
  638.     
  639.     # Build regular expressions with URL attrs.
  640.     set exp "("
  641.     foreach attr $htmlURLAttr {
  642.         append exp "$attr|"
  643.     }
  644.     set exp [string trimright $exp |]
  645.     append exp ")"
  646.  
  647.     
  648. #     set exprr "$exp\"?(\[^ \\t\\n\\r\">\]+)\"?"
  649.     set exprr "${exp}(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  650.  
  651.     # Update links to the moved files.
  652.     set toModify [htmlScanFiles $allfiles $fromBase $fromPath $homepage $isinfld 0 0 $movedFiles]
  653.  
  654.     set num 0
  655.     set changed ""
  656.     if {[llength $toModify]} {
  657.         set thisfile ""
  658.         foreach modify $toModify {
  659.             set fil [lindex $modify 0]
  660.             if {$thisfile != $fil} {
  661.                 if {[string length $thisfile]} {
  662.                     if {[catch {open $thisfile w} fid]} {
  663.                         alertnote "Could not update [file tail $thisfile]. An error occured."
  664.                     } else {
  665.                         puts -nonewline $fid [join $filecont "\r"]
  666.                         close $fid
  667.                     }
  668.                 }
  669.                 message "Modifying [file tail $fil]…"
  670.                 foreach w [winNames -f] {
  671.                     if {[stripNameCount $w] == "$fil"} {
  672.                         lappend changed $w
  673.                     }
  674.                 }
  675.                 set fid [open $fil r]
  676.                 incr num
  677.                 set filec [read $fid]
  678.                 close $fid
  679.                 if {[regexp {\n} $filec]} {
  680.                     set newln "\n"
  681.                 } else {
  682.                     set newln "\r"
  683.                 }
  684.                 set filec [split $filec $newln]
  685.                 set filecont ""
  686.                 foreach fc $filec {
  687.                     lappend filecont [string trimleft $fc "\r"]
  688.                 }
  689.             }
  690.             set thisfile $fil
  691.             set linenum [expr [lindex $modify 1] - 1]
  692.             set line [lindex $filecont $linenum]
  693.             set path [lindex $movedFiles2 [lsearch -exact $movedFiles [lindex $modify 5]]]
  694.             set lnk [htmlBASEfromPath $path]
  695.             if {[lindex $modify 2] == [lindex $lnk 0]} {
  696.                 set linkTo [htmlRelativePath "[lindex $modify 3][lindex $modify 4]" "[lindex $lnk 1][lindex $lnk 2]"]
  697.             } else {
  698.                 set linkTo [join [lrange $lnk 0 2] ""]
  699.             }
  700.             set linkTo [htmlURLescape2 $linkTo]
  701.             regexp -indices [lindex $modify 6] $line href
  702.             regexp -nocase -indices $exprr [string range $line [lindex $href 0] [lindex $href 1]] a b url
  703.             set anchor ""
  704.             regexp {[^#]*(#[^\"]*)} [lindex $modify 6] a anchor
  705.             set line "[string range $line 0 [expr [lindex $href 0] + [lindex $url 0] - 1]]\"$linkTo$anchor\"[string range $line [expr [lindex $href 0] + [lindex $url 1] + 1] end]"
  706.             set filecont [lreplace $filecont $linenum $linenum $line]
  707.         }
  708.         if {[catch {open $thisfile w} fid]} {
  709.             alertnote "Could not update [file tail $thisfile]. An error occured."
  710.         } else {
  711.             puts -nonewline $fid [join $filecont "\r"]
  712.             close $fid
  713.         }
  714.     }
  715.     return [list $num $changed]
  716. }
  717.  
  718. # Updates links in moved files.
  719. proc htmlUpdateAfterMove2 {movedFiles movedFiles2 fromBase fromPath homepage} {
  720.     global htmlURLAttr
  721.     
  722.     set expBase "<(base\[ \\t\\n\\r\]+)\[^>\]*>"
  723.     set expBase2 "(href=)\"?(\[^ \\t\\n\\r\">\]+)\"?"
  724.  
  725.     # Build regular expressions with URL attrs.
  726.     set exp "("
  727.     foreach attr $htmlURLAttr {
  728.         append exp "$attr|"
  729.     }
  730.     set exp [string trimright $exp |]
  731.     append exp ")"
  732.  
  733.     
  734.     set exprr2 "\[ \\t\\n\\r\]+$exp\"?(\[^ \\t\\n\\r\">\]+)\"?"
  735.  
  736.     set num 0
  737.     foreach f $movedFiles2 {
  738.         getFileInfo $f finfo
  739.         if {$finfo(type) != "TEXT"} {continue}
  740.         message "Modifying [file tail $f]…"
  741.         set fid [open $f r]
  742.         set filecont [read $fid]
  743.         close $fid
  744.         set oldfile [lindex $movedFiles [lsearch -exact $movedFiles2 $f]]
  745.         set base $fromBase
  746.         set path $fromPath
  747.         set hpPath $homepage
  748.         set epath [string range $oldfile [expr [string length $homepage] + 1] end]
  749.         regsub -all {:} $epath {/} epath
  750.         # Replace newline chars in IBM files.
  751.         regsub -all "\n\r" $filecont "\r" filecont
  752.         # If BASE is used, only modify links to moved files.
  753.         if {[regexp -nocase $expBase $filecont this] && \
  754.         [regexp -nocase $expBase2 $this d1 d2 url1]} {
  755.             set hasBase 1
  756.         } else {
  757.             set hasBase 0
  758.         }
  759.         if {$hasBase && ![catch {htmlBASEpieces $url1} basestr]} {
  760.             set base [lindex $basestr 0]
  761.             set path [lindex $basestr 1]
  762.             set epath [lindex $basestr 2]
  763.             set hpPath ""
  764.         }
  765.         incr num
  766.         set newcont ""
  767.         while {[regexp -nocase -indices $exprr2 $filecont href b url]} {
  768.             set urltxt [string range $filecont [lindex $url 0] [lindex $url 1]]
  769.             set anchor ""
  770.             regexp {[^#]*(#[^\"]*)} $urltxt a anchor
  771.             set urltxt [htmlURLunEscape $urltxt]
  772.             if {[catch {lindex [htmlPathToFile $base $path $epath $hpPath $urltxt] 0} topath]} {set topath ""}
  773.             # Ignore anchors if not moved and BASE.
  774.             # Is the link pointing to a previously moved file?
  775.             if {[set mvind [lsearch -exact $movedFiles $topath]] >= 0} {
  776.                 set topath [lindex $movedFiles2 $mvind]
  777.                 if {!$hasBase && [string index $urltxt 0] == "#"} {set topath ""}
  778.             } elseif {[string index $urltxt 0] == "#"} {
  779.                 set topath ""
  780.             }
  781.                 
  782.             if {$hasBase && [regexp -nocase -indices $expBase $filecont thisLine] \
  783.             && [regexp -nocase $expBase2 [string range $filecont [lindex $thisLine 0] [lindex $thisLine 1]]]\
  784.             && [lindex $thisLine 0] < [lindex $url 0] && [lindex $thisLine 1] > [lindex $url 1]} {
  785.                 set topath ""
  786.             }
  787.             if {[string length $topath]} {
  788.                 set lnk [htmlBASEfromPath $topath]
  789.                 if {!$hasBase} {
  790.                     set lnk1 [htmlBASEfromPath $f]
  791.                     set path2 [lindex $lnk1 1]
  792.                     set epath2 [lindex $lnk1 2]
  793.                 } else {
  794.                     set path2 $path
  795.                     set epath2 $epath
  796.                 }
  797.                 if {$base == [lindex $lnk 0]} {
  798.                     set newurl [htmlRelativePath "$path2$epath2" "[lindex $lnk 1][lindex $lnk 2]"]
  799.                 } else {
  800.                     set newurl [join [lrange $lnk 0 2] ""]
  801.                 }
  802.                 append newurl $anchor
  803.             } elseif {!$hasBase && ($urltxt == ".." || [string range $urltxt 0 2] == "../")} {
  804.                 # Special case with relative links outside home page.
  805.                 set urlspl [split $urltxt /]
  806.                 set old [split $oldfile :]
  807.                 set new [split $f :]
  808.                 if {[llength $new] > [llength $old]} {
  809.                     set newurl ""
  810.                     for {set i 0} {$i < [expr [llength $new] - [llength $old]]} {incr i} {
  811.                         append newurl "../"
  812.                     }
  813.                     append newurl $urltxt
  814.                 } else {
  815.                     set ok 1
  816.                     for {set i 0} {$i < [expr [llength $old] - [llength $new]]} {incr i} {
  817.                         if {[lindex $urlspl $i] != ".."} {set ok 0}
  818.                     }
  819.                     if {$ok} {
  820.                         set newurl "[join [lrange $urlspl [expr [llength $old] - [llength $new]] end] /]$anchor"
  821.                     } else {
  822.                         set newurl $urltxt
  823.                     }
  824.                 }
  825.             } else {
  826.                 set newurl $urltxt
  827.             }
  828.             append newcont [string range $filecont 0 [expr [lindex $url 0] - 1]]
  829.             append newcont [htmlURLescape2 $newurl]
  830.             set filecont [string range $filecont [expr [lindex $url 1] + 1] end]
  831.         }
  832.         append newcont $filecont
  833.         if {[catch {open $f w} fid]} {
  834.             alertnote "Could not update [file tail $f]. An error ocurred."
  835.         } else {
  836.             puts -nonewline $fid $newcont
  837.             close $fid
  838.         }
  839.     }
  840.     return $num
  841. }
  842.  
  843. # Updates include links to moved files in include folder.
  844. proc htmlUpdateAfterMove3 {movedFiles movedFiles2 homepage} {
  845.     set num 0
  846.     set changed ""
  847.     foreach fil [htmlAllHTMLfiles $homepage] {
  848.         if {[catch {open $fil r} fid]} {continue}
  849.         set filecont [read $fid]
  850.         close $fid
  851.         message "Looking at [file tail $fil]…"
  852.         regsub -all "\n\r" $filecont "\r" filecont
  853.         set newcont ""
  854.         set ismod 0
  855.         while {[regexp -nocase -indices {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>} $filecont res]} {
  856.             set link [string range $filecont [lindex $res 0] [lindex $res 1]]
  857.             if {[regexp -nocase -indices {FILE=\"([^\"]+)\"} $link dum res1] &&
  858.             [set ind [lsearch -exact $movedFiles [htmlUnQuote [string range $link [lindex $res1 0] [lindex $res1 1]]]]] >= 0} {
  859.                 append newcont [string range $filecont 0 [expr [lindex $res 0] + [lindex $res1 0] - 1]]
  860.                 append newcont [htmlQuote [lindex $movedFiles2 $ind]]
  861.                 append newcont [string range $filecont [expr [lindex $res 0] + [lindex $res1 1] + 1] [lindex $res 1]]
  862.                 set ismod 1
  863.                 message "Modifying [file tail $fil]…"
  864.             } else {
  865.                 append newcont [string range $filecont 0 [lindex $res 1]]
  866.             }
  867.             set filecont [string range $filecont [expr [lindex $res 1] + 1] end]
  868.         }
  869.         if {$ismod} {
  870.             if {[catch {open $fil w} fid]} {
  871.                 alertnote "Could not update [file tail $fil]. An error occured."
  872.             } else {
  873.                 puts -nonewline $fid "$newcont$filecont"
  874.                 close $fid
  875.             }
  876.             incr num
  877.             foreach w [winNames -f] {
  878.                 if {[stripNameCount $w] == "$fil"} {
  879.                     lappend changed $w
  880.                 }
  881.             }
  882.         }
  883.     }
  884.     return [list $num $changed]
  885. }
  886.  
  887. #
  888. # dividing line
  889. #
  890. proc htmlDividingLine {} {
  891.     global HTMLmodeVars fillColumn
  892.     set wordWrap    $HTMLmodeVars(wordWrap)
  893.     set comStr    [htmlCommentStrings]
  894.     set prefixString [lindex $comStr 0]
  895.     set suffixString [lindex $comStr 1]
  896.     set s "===================================================================================="
  897.     set l [expr [string length $prefixString] + [string length $suffixString]]
  898.     if {$wordWrap} { 
  899.         set l [expr $fillColumn - $l - 1] 
  900.     } else {
  901.         set l [expr 75 - $l - 1]
  902.     }
  903.     insertText [htmlOpenCR] $prefixString [string range $s 0 $l] $suffixString "\r"
  904. }
  905.  
  906.  
  907. # Removes all tab marks from the current selection (if there is one) 
  908. # or the current document, maintaining the cursor position in the 
  909. # latter case. Stolen from latexMacros.tcl written by Tom Scavo.
  910. proc htmlTabDeleteAll {} {
  911.  
  912.     set subs1 0; set subs2 0; set subs3 0
  913.     set pos [getPos]
  914.     if {[set start $pos] == [set end [selEnd]]} {
  915.         set messageString "document"
  916.         set start 0
  917.         set end [maxPos]
  918.         set text1 [getText $start $pos]
  919.         set subs1 [regsub -all {•} $text1 {} text1]
  920.         set text2 [getText $pos $end]
  921.         set subs2 [regsub -all {•} $text2 {} text2]
  922.         append text $text1 $text2
  923.     } else {
  924.         set messageString "selection"
  925.         set text [getText $start $end]
  926.         set subs3 [regsub -all {•} $text {} text]
  927.     }
  928.     if {$subs1 || $subs2 || $subs3} then {
  929.         replaceText $start $end $text
  930.         if {$messageString == "document"} then {
  931.             goto [expr $pos - $subs1]
  932.         } else {
  933.             set end [getPos]
  934.             select $start $end
  935.         }
  936.         set subs [expr $subs1 + $subs2 + $subs3]
  937.         message "$subs tab marks removed from $messageString."
  938.     } else {
  939.         message "No tab marks found in $messageString."
  940.     }
  941. }
  942.  
  943. #
  944. # Converting  characters to HTML entities.
  945. #
  946. # 1 = < > &
  947. # 0 = áé etc.
  948. proc htmlCharacterstohtml {ltgtamp} {
  949.     global htmlSpecialCharacter 
  950.     global htmlSpecialCapCharacter htmlSpecialSymbCharacter
  951.     
  952.     if {$ltgtamp} {
  953.         set charlist {& < >}
  954.     } else {    
  955.         foreach a [array names htmlSpecialCharacter] {
  956.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  957.                 lappend charlist $a
  958.             }
  959.         }
  960.         
  961.         foreach a [array names htmlSpecialCapCharacter] {
  962.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  963.                 lappend charlist $a
  964.             }
  965.         }
  966.         lappend charlist ¡ ¿
  967.     }
  968.     
  969.     set subs1 0;  set lett 0
  970.     set pos [getPos]
  971.     if {[set start $pos] == [set end [selEnd]]} {
  972.         if {$ltgtamp && \
  973.         [askyesno "There is no selection. Really translate < > & in whole document?"] == "no"} {return}
  974.         set messageString "document"
  975.         set start 0
  976.         set end [maxPos]
  977.         set isDoc 1
  978.     } else {
  979.         set messageString "selection"
  980.         set isDoc 0
  981.     }
  982.     message "Translating…"
  983.     set text [getText $start $end]
  984.     set tmp $text
  985.     set upos $pos
  986.     set st $start
  987.     if {!$ltgtamp} {
  988.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  989.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  990.             if {[expr $st + [lindex $str 1]] < $upos} {
  991.                 incr pos [expr 17 - [string length $sv]]
  992.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  993.                 incr pos [expr $st + [lindex $str 0] - $upos]
  994.             }
  995.             lappend savestr $sv
  996.             set tmp [string range $tmp [lindex $str 1] end]
  997.             incr st [lindex $str 1]
  998.         }
  999.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  1000.     }
  1001.     if {$isDoc} {    
  1002.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  1003.         set text2 [string range $text [expr $pos - $start] end]
  1004.     } else {
  1005.         set text1 $text
  1006.     }
  1007.     foreach char $charlist {
  1008.  
  1009.         if {[info exists htmlSpecialCharacter($char)]} {
  1010.             set rtext "\\&$htmlSpecialCharacter($char);"
  1011.         } elseif {[info exists htmlSpecialCapCharacter($char)]} {
  1012.             set rtext "\\&$htmlSpecialCapCharacter($char);"
  1013.         } elseif {[info exists htmlSpecialSymbCharacter($char)]} {
  1014.             set rtext "\\&$htmlSpecialSymbCharacter($char);"
  1015.         } elseif {$char == ">"} {
  1016.             set rtext "\\>" 
  1017.         } elseif {$char == "<"} {
  1018.             set rtext "\\<"
  1019.         } elseif {$char == "&"} {
  1020.             set rtext "\\&"
  1021.         }
  1022.         
  1023.         set subNum [regsub -all $char $text1 [set rtext] text1]
  1024.         incr subs1 [expr $subNum * ([string length $rtext] - 2)]
  1025.         incr lett $subNum
  1026.         if {$isDoc} {
  1027.             incr lett [regsub -all $char $text2 [set rtext] text2]
  1028.         }
  1029.         
  1030.     }
  1031.     set text $text1
  1032.     if {$isDoc} {append text $text2}
  1033.     if {$lett} {
  1034.         if {[info exists savestr]} {
  1035.             set i 0
  1036.             set tmp ""
  1037.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  1038.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  1039.                 append tmp [lindex $savestr $i]
  1040.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  1041.                 incr i
  1042.             }
  1043.             set text "$tmp$text"
  1044.         }
  1045.         replaceText $start $end $text
  1046.         if {$isDoc} {
  1047.             goto [expr $upos + $subs1]
  1048.         } else {
  1049.             set end [getPos]
  1050.             select $start $end
  1051.         }
  1052.     }
  1053.     message "$lett characters translated in $messageString."
  1054. }
  1055.  
  1056.  
  1057.  
  1058. #
  1059. # Converting HTML entities to characters.
  1060. #
  1061. # 1 = < > &
  1062. # 0 = áé etc.
  1063. proc htmltoCharacters {ltgtamp} {
  1064.     global htmlCharacterSpecial  
  1065.     global htmlCapCharacterSpecial 
  1066.     
  1067.     message "Translating…"
  1068.     
  1069.     if {$ltgtamp} {
  1070.         set entitylist {"&" "<" ">"} 
  1071.     } else {
  1072.         foreach a [array names htmlCharacterSpecial] {
  1073.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  1074.                 lappend entitylist "&$a;"
  1075.             }
  1076.         }
  1077.         
  1078.         foreach a [array names htmlCapCharacterSpecial] {
  1079.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  1080.                 lappend entitylist "&$a;"
  1081.             }
  1082.         }
  1083.         # ¡ ¿
  1084.         lappend entitylist "¡" "¿"
  1085.     }
  1086.     set subs1 0;  set lett 0
  1087.     set pos [getPos]
  1088.     if {[set start $pos] == [set end [selEnd]]} {
  1089.         # Move position to linestart to make sure no letter is split.
  1090.         set pos [lineStart $pos]
  1091.         set messageString "document"
  1092.         set start 0
  1093.         set end [maxPos]
  1094.         set isDoc 1
  1095.     } else {
  1096.         set messageString "selection"
  1097.         set isDoc 0
  1098.     }
  1099.  
  1100.     set text [getText $start $end]
  1101.     set tmp $text
  1102.     set upos $pos
  1103.     set st $start
  1104.     if {!$ltgtamp} {
  1105.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  1106.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  1107.             if {[expr $st + [lindex $str 1]] < $upos} {
  1108.                 incr pos [expr 17 - [string length $sv]]
  1109.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  1110.                 incr pos [expr $st + [lindex $str 0] - $upos]
  1111.             }
  1112.             lappend savestr $sv
  1113.             set tmp [string range $tmp [lindex $str 1] end]
  1114.             incr st [lindex $str 1]
  1115.         }
  1116.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  1117.     }
  1118.     if {$isDoc} {
  1119.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  1120.         set text2 [string range $text [expr $pos - $start] end]
  1121.     } else {
  1122.         set text1 $text
  1123.     }        
  1124.     foreach char $entitylist {
  1125.         set schar [string range $char 1 [expr [string length $char] - 2]]
  1126.         if {[info exists htmlCharacterSpecial($schar)]} {
  1127.             set rtext "$htmlCharacterSpecial($schar)"
  1128.         } elseif {[info exists htmlCapCharacterSpecial($schar)]} {
  1129.             set rtext "$htmlCapCharacterSpecial($schar)"
  1130.         } elseif {$schar == "#161"} {
  1131.             set rtext ¡
  1132.         } elseif {$schar == "#191"} {
  1133.             set rtext ¿
  1134.         } elseif {$schar == "amp"} {
  1135.             set rtext "\\&"
  1136.         } elseif {$schar == "lt"} {
  1137.             set rtext "<"
  1138.         } elseif {$schar == "gt"} {
  1139.             set rtext ">"
  1140.         }
  1141.         
  1142.         set subNum [regsub -all $char $text1 $rtext text1]
  1143.         incr subs1 [expr $subNum * ([string length $char] - 1)]
  1144.         incr lett $subNum
  1145.         if {$isDoc} {
  1146.             incr lett [regsub -all $char $text2 $rtext text2]
  1147.         }
  1148.         
  1149.     }
  1150.     set text $text1
  1151.     if {$isDoc} {append text $text2}
  1152.     if {$lett} {
  1153.         if {[info exists savestr]} {
  1154.             set i 0
  1155.             set tmp ""
  1156.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  1157.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  1158.                 append tmp [lindex $savestr $i]
  1159.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  1160.                 incr i
  1161.             }
  1162.             set text "$tmp$text"
  1163.         }
  1164.         replaceText $start $end $text
  1165.         if {$isDoc} {
  1166.             goto [expr $upos - $subs1]
  1167.         } else {
  1168.             set end [getPos]
  1169.             select $start $end
  1170.         }
  1171.     }
  1172.     message "$lett characters translated in $messageString."
  1173. }
  1174.  
  1175.  
  1176. #===============================================================================
  1177. # HTML character entities
  1178. #===============================================================================
  1179.  
  1180. proc htmlAddCommonChars {} {
  1181.     global modifiedModeVars HTMLmodeVars htmlSpecialCharacter htmlCapCharSpecMenu
  1182.     global htmlSpecialSymbCharacter
  1183.     set commonChars $HTMLmodeVars(commonChars)
  1184.  
  1185.     set htmlCharacters [lsort [array names htmlSpecialCharacter]]
  1186.     set htmlCapCharacters [lsort [array names htmlCapCharSpecMenu]]
  1187.     set htmlSymbCharacters [lsort [array names htmlSpecialSymbCharacter]]
  1188.     set htmlAllCharacters [concat $htmlCharacters $htmlCapCharacters $htmlSymbCharacters]
  1189.     if {![catch {listpick -l -p "Select chars for the commonly used char list" \
  1190.                 $htmlAllCharacters} newchars]} {
  1191.         set dirty 0
  1192.         foreach c $newchars {
  1193.             if {[lsearch -exact $commonChars $c] < 0} {
  1194.                 set dirty 1
  1195.                 set commonChars [lsort [lappend commonChars $c]]
  1196.             }
  1197.         }
  1198.         if {$dirty} {
  1199.             lappend modifiedModeVars {commonChars HTMLmodeVars}
  1200.             set HTMLmodeVars(commonChars) $commonChars
  1201.             message "Rebuiding HTML menu…"
  1202.             htmlBuildMenu
  1203.             message "New characters added to the common list."
  1204.         }
  1205.     }
  1206. }
  1207.  
  1208. proc htmlDefaultCommonChars {} {
  1209.     global modifiedModeVars HTMLmodeVars
  1210.     
  1211.     if {[askyesno "Revert to default common characters?"] == "yes"} {
  1212.         set HTMLmodeVars(commonChars) $HTMLmodeVars(defaultCommonChars)
  1213.         lappend modifiedModeVars {commonChars HTMLmodeVars}
  1214.         message "Rebuiding HTML menu…"
  1215.         htmlBuildMenu
  1216.         message "Common character list reverted to default."
  1217.     }    
  1218. }
  1219.  
  1220. proc htmlClearCommonChars {} {
  1221.     global modifiedModeVars HTMLmodeVars
  1222.     
  1223.     if {[askyesno "Remove all common characters?"] == "yes"} {
  1224.         set HTMLmodeVars(commonChars) {}
  1225.         lappend modifiedModeVars {commonChars HTMLmodeVars}
  1226.         message "Rebuiding HTML menu…"
  1227.         htmlBuildMenu
  1228.         message "Common character list cleared."
  1229.     }    
  1230. }
  1231.  
  1232. #
  1233. # Insert special character entity
  1234. #
  1235. proc htmlInsertCharacter {char} {
  1236.     global htmlSpecialCharacter htmlCapCharSpecMenu htmlSpecialSymbCharacter
  1237.     if {[isSelection]} { deleteSelection }
  1238.     foreach c [list SpecialCharacter CapCharSpecMenu SpecialSymbCharacter] {
  1239.         if {[info exists html${c}($char)]} {
  1240.             insertText &[set html${c}($char)]\;
  1241.         }
  1242.     }
  1243. }
  1244.  
  1245.  
  1246.  
  1247. #===============================================================================
  1248. # General Commands
  1249. #===============================================================================
  1250.  
  1251. # remove containing tags
  1252. proc htmlUnTag {selectit} {
  1253.     set curPos [getPos]
  1254.     set tags [htmlGetContainer $curPos [selEnd]]
  1255.     if {[llength $tags] < 5} {
  1256.         alertnote "Cannot decide on enclosing tags."
  1257.         return
  1258.     }
  1259.     # delete them
  1260.     replaceText [lindex $tags 0] [lindex $tags 3] \
  1261.     [getText [lindex $tags 1] [lindex $tags 2]]
  1262.     if {$selectit} {
  1263.         select [lindex $tags 0] \
  1264.             [expr [lindex $tags 2] - [lindex $tags 1] + [lindex $tags 0]]
  1265.     } else {
  1266.         if {$curPos < [lindex $tags 1]} {set curPos [lindex $tags 1]}
  1267.         if {$curPos > [lindex $tags 2]} {set curPos [lindex $tags 2]}
  1268.         goto [expr $curPos - [lindex $tags 1] + [lindex $tags 0]]
  1269.     }
  1270.     message "[lindex $tags 4] deleted."
  1271. }
  1272.  
  1273. # select container, like Balance (cmd-B)
  1274. proc htmlBalance {inside} {
  1275.     set start [getPos]
  1276.     if {$start != 0 &&
  1277.             ![catch {getText $start [expr $start + 2]} lookingAt] &&
  1278.             $lookingAt != "</" &&
  1279.             [string range $lookingAt 0 0] == "<"} {
  1280.         incr start -1
  1281.     }
  1282.     set tags [htmlGetContainer $start [selEnd]]
  1283.     if {[llength $tags] == 5} {
  1284.         if {$inside} {
  1285.             select [lindex $tags 1] [lindex $tags 2]
  1286.         } else {
  1287.             select [lindex $tags 0] [lindex $tags 3]
  1288.         }
  1289.         message "[lindex $tags 4] selected."
  1290.     } else {
  1291.         beep
  1292.         message "Cannot decide on enclosing tags."
  1293.     }
  1294. }
  1295.  
  1296. # Select an opening tag, or remove it, of an element without a closing tag.
  1297. proc htmlSelectOpening {remove} {
  1298.     set begin [getPos]
  1299.     # back up one if possible and selection is wanted.
  1300.     if {$begin >0 && !$remove} {incr begin -1}
  1301.     set tag [htmlGetOpening $begin]
  1302.     if {[llength $tag] == 3} {
  1303.         if {$remove} {
  1304.             deleteText [lindex $tag 0] [lindex $tag 1]
  1305.             if {$begin < [lindex $tag 1]} {set begin [lindex $tag 1]}
  1306.             goto [expr $begin - [lindex $tag 1] + [lindex $tag 0]]
  1307.             message "[lindex $tag 2] deleted."
  1308.         } else {
  1309.             select [lindex $tag 0] [lindex $tag 1]
  1310.             message "[lindex $tag 2] selected."
  1311.         }
  1312.     } else {
  1313.         if {$remove} {
  1314.             alertnote "Cannot find opening tag."
  1315.         } else {
  1316.             beep
  1317.             message "Cannot find opening tag."
  1318.         }
  1319.     }
  1320. }
  1321.  
  1322. # Change an existing element.
  1323. proc htmlChangeContainer {} {
  1324.     set tag [htmlGetContainer [getPos] [selEnd]]
  1325.     if {[llength $tag] == 5} {
  1326.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  1327.         [expr [lindex $tag 1] - 1]] [lindex $tag 4] [lindex $tag 0]]
  1328.         if {[string length $newTag]} {
  1329.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  1330.         }
  1331.     } else {
  1332.         alertnote "Cannot decide on enclosing tags."
  1333.     }
  1334. }
  1335.  
  1336. proc htmlChangeOpening {} {
  1337.     set tag [htmlGetOpening [getPos]]
  1338.     if {[llength $tag] == 3} {
  1339.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  1340.         [expr [lindex $tag 1] - 1]] [lindex $tag 2] [lindex $tag 0]]
  1341.         if {[string length $newTag]} {
  1342.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  1343.         }
  1344.     } else {
  1345.         alertnote "Cannot find opening tag."
  1346.     }
  1347. }
  1348.  
  1349. #
  1350. # Exstracts all attributes to a element from a list, and puts up a dialog window
  1351. # where the user can change the attributes.
  1352. #
  1353. proc htmlChangeElement {tag elem {wrPos 0}} {
  1354.     global htmlColorAttr htmlURLAttr HTMLmodeVars
  1355.     global htmluserColorname htmlColorNumber htmlPackageToUse
  1356.     global htmlElemAttrOptional1 htmlElemAttrOptional3
  1357.     global htmlElemEventHandler1 htmlWindowAttr htmlPlugins
  1358.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  1359.  
  1360.     # Remove tabs and returns from list.
  1361.     regsub -all "\[\t\r\]+" $tag " " tag
  1362.     
  1363.     # Remove element name.
  1364.     set tagelem [lindex $tag 0]
  1365.     set tag [string range $tag [string length $tagelem] end]
  1366.     set attrs ""
  1367.     set attrVals ""
  1368.     
  1369.     # Exstract the attributes.
  1370.     while {[regexp {[ ]+([^ "]+"[^"]*"|[^ "]+)} $tag thisatt]} {
  1371.         set tag [string range $tag [string length $thisatt] end]
  1372.         set thisatt [htmlRemoveQuotes $thisatt]
  1373.         lappend attrs [string trim [lindex $thisatt 0]]
  1374.         lappend attrVals [lindex $thisatt 1]
  1375.     }    
  1376.     
  1377.     # All INPUT elements are defined differently. Must extract TYPE.
  1378.     if {$elem == "INPUT"} {
  1379.         set typeIndex [lsearch -exact [string toupper $attrs] "TYPE="]
  1380.         if {$typeIndex >= 0 } {
  1381.             set elem [string toupper [lindex $attrVals $typeIndex]]
  1382.             # Remove TYPE attribute from list.
  1383.             set attrs [lreplace $attrs $typeIndex $typeIndex]
  1384.             set attrVals [lreplace $attrVals $typeIndex $typeIndex]
  1385.             set used "INPUT TYPE=\"${elem}\""
  1386.         } else {
  1387.             beep 
  1388.             message "INPUT element without a TYPE attribute."
  1389.             return
  1390.         } 
  1391.     } else {
  1392.         set used $elem
  1393.     }
  1394.     
  1395.     # If EMBED element, choose which
  1396.     if {$elem == "EMBED" && $htmlPackageToUse == 1} {
  1397.         if {[catch {listpick -p "Which plug-in?" [lsort $htmlPlugins]} elem] || ![string length $elem]} {return}
  1398.     }
  1399.     
  1400.     # If LI element and Extensions package, check in which list.
  1401.     if {$elem == "LI"} {
  1402.         set ltype [htmlFindList]
  1403.         if {$ltype == "UL"} {
  1404.             set elem "LI IN UL"
  1405.         } elseif {$ltype == "OL"} {
  1406.             set elem "LI IN OL"
  1407.         }            
  1408.     }
  1409.     
  1410.     set eventText ""
  1411.     
  1412.     # JavaScript event handlers. Extension package only.
  1413.     if {$htmlPackageToUse == 1 && [info exists htmlElemEventHandler1($elem)]} {
  1414.         set eventHandler [string toupper $htmlElemEventHandler1($elem)]
  1415.     } else {
  1416.         set eventHandler ""
  1417.     }
  1418.     # Remove event handler from attributes list,
  1419.     # if they should not be included, and save them to put them back later.
  1420.     set attrsToupper [string toupper $attrs]
  1421.     if {!$HTMLmodeVars(inclEventHandler)} {
  1422.         foreach ev $eventHandler {
  1423.             set evIndex [lsearch -exact $attrsToupper $ev]
  1424.             if {$evIndex >=0} {
  1425.                 append eventText " " [lindex $attrs $evIndex] \
  1426.                 [htmlAddQuotes [lindex $attrVals $evIndex]]
  1427.                 set attrs [lreplace $attrs $evIndex $evIndex]
  1428.                 set attrVals [lreplace $attrVals $evIndex $evIndex]
  1429.                 set attrsToupper [lreplace $attrsToupper $evIndex $evIndex]
  1430.             }
  1431.         }
  1432.     }
  1433.     
  1434.     set attrs $attrsToupper
  1435.         
  1436.     # Element known by HTML mode?
  1437.     if {![info exists htmlElemAttrOptional${htmlPackageToUse}($elem)]} {
  1438.         alertnote "Unknown element: $elem"
  1439.         return
  1440.     }
  1441.     
  1442.     set allAttrs [concat [htmlGetRequired $elem] [htmlGetOptional $elem]]
  1443.     if {[string length $eventHandler]} {append allAttrs " " $eventHandler}
  1444.     
  1445.     set choices [htmlGetChoices $elem]
  1446.     set numAttrs [htmlGetNumber $elem]
  1447.     
  1448.     set errText ""
  1449.     
  1450.     # Check if there are some unknown attributes.
  1451.     foreach a $attrs {
  1452.         if {[lsearch -exact $allAttrs $a] < 0} {
  1453.             lappend errText "Unknown attribute: $a"
  1454.         }
  1455.     }
  1456.     
  1457.     # Does this element have any attributes?
  1458.     if {![llength $allAttrs]} {
  1459.         if {[llength $errText]} {
  1460.             if {[askyesno "$elem has no attributes. Remove the ones in the text?"] == "no"} {
  1461.                 return
  1462.             } else {
  1463.                 # Remove the error text to prevent another popup window.
  1464.                 set errText ""
  1465.             }
  1466.         } else {
  1467.             beep
  1468.             message "$elem has no attributes."
  1469.             return
  1470.         }
  1471.     } 
  1472.             
  1473.     # Add two dummy elements for OK and Cancel buttons.
  1474.     set values {0 0}
  1475.  
  1476.     # Build a list with attribute vales.
  1477.     foreach a $allAttrs {
  1478.         set attrIndex [lsearch -exact $attrs $a]
  1479.         if {$attrIndex >= 0 } {set aval [lindex $attrVals $attrIndex]}
  1480.         set a2 [string trimright $a =]
  1481.         if {[string index $a [expr [string length $a] - 1]] != "="} {
  1482.             # Flag
  1483.             if {$attrIndex >= 0} {
  1484.                 lappend values 1
  1485.             } else {
  1486.                 lappend values 0
  1487.             } 
  1488.         } elseif {([lsearch -exact $htmlURLAttr $a] >= 0 && [lsearch -exact $htmlSpecURL "${elem}!=$a2"] < 0) || \
  1489.             [lsearch -exact $htmlSpecURL "${elem}=$a2"] >= 0} {
  1490.                 # URL
  1491.             if {$attrIndex >= 0} {
  1492.                 set aval [htmlURLunEscape $aval]
  1493.                 htmlAddToCache URLs $aval
  1494.                 lappend values "" $aval 0
  1495.             } else {
  1496.                 lappend values "" "No value" 0
  1497.             }
  1498.         } elseif {([lsearch -exact $htmlColorAttr $a] >= 0 && [lsearch -exact $htmlSpecColor "${elem}!=$a2"] < 0) || \
  1499.         [lsearch -exact $htmlSpecColor "${elem}=$a2"] >= 0} {
  1500.             # Color
  1501.             if {$attrIndex >= 0} {
  1502.                 set aval [htmlCheckColorNumber $aval]
  1503.                 if {$aval == 0} {
  1504.                     lappend errText "$a: Invalid color number."
  1505.                     lappend values "" "No value" 0
  1506.                 } elseif {[info exists htmluserColorname($aval)]} {
  1507.                     lappend values "" $htmluserColorname($aval) 0
  1508.                 } elseif {[info exists htmlColorNumber($aval)]} {
  1509.                     lappend values "" $htmlColorNumber($aval) 0
  1510.                 } else {
  1511.                     lappend values $aval "No value" 0
  1512.                 }
  1513.             } else {
  1514.                 lappend values "" "No value" 0
  1515.             }
  1516.         } elseif {([lsearch -exact $htmlWindowAttr $a] >= 0 && [lsearch -exact $htmlSpecWindow "${elem}!=$a2"] < 0) || \
  1517.         [lsearch -exact $htmlSpecWindow "${elem}=$a2"] >= 0} {
  1518.             # Window
  1519.             if {$attrIndex >= 0} {
  1520.                 htmlAddToCache windows $aval
  1521.                 lappend values "" $aval
  1522.             } else {
  1523.                 lappend values "" "No value"
  1524.             }
  1525.         } elseif {[lsearch $numAttrs "${a}*"] >= 0} {
  1526.             # Number
  1527.             if {$attrIndex >= 0} {
  1528.                 set numcheck [htmlCheckAttrNumber $elem $a $aval]
  1529.                 if {$numcheck == 1} {
  1530.                     lappend values $aval
  1531.                 } else {
  1532.                     lappend errText "$a: $numcheck"
  1533.                     lappend values ""
  1534.                 }
  1535.             } else {
  1536.                 lappend values ""
  1537.             }
  1538.         } elseif {[lsearch $choices "${a}*"] >= 0} {
  1539.             # Choices
  1540.             if {$attrIndex >= 0} {
  1541.                 set match ""
  1542.                 if {!(($elem == "OL" || $elem == "LI IN OL") && $a == "TYPE=")} {
  1543.                     set aval [string toupper $aval]
  1544.                 }
  1545.                 foreach w $choices {
  1546.                     if {$w == "${a}${aval}"} {
  1547.                         set match $aval
  1548.                     }
  1549.                 }
  1550.                 if {[string length $match]} {
  1551.                     lappend values $match
  1552.                 } else {
  1553.                     lappend errText "$a: Unknown choice, $aval."
  1554.                     lappend values "No value"
  1555.                 }
  1556.             } else {
  1557.                 lappend values "No value"
  1558.             }    
  1559.         } elseif {$attrIndex >= 0} {
  1560.             # Any other
  1561.             lappend values $aval
  1562.         } else {
  1563.             lappend values ""
  1564.         }
  1565.     }
  1566.     # If invalid attributes, continue?
  1567.     if {[llength $errText] && ![htmlErrorWindow "$elem not well-defined" $errText 1]} {
  1568.         return 
  1569.     }
  1570.     
  1571.     set r [htmlOpenElemWindow $used $elem [lindex [posToRowCol $wrPos] 1] $values]
  1572.     # Put back event handlers. Empty string means "Cancel", do nothing.
  1573.     if {[string length $r]} {
  1574.         set r "[string range $r 0 [expr [string length $r] - 2]]$eventText>"
  1575.     }
  1576.     return $r
  1577. }
  1578.  
  1579. # opens the manual in the browser.
  1580. proc htmlManual {} {
  1581.     global HOME HTMLmodeVars modifiedModeVars
  1582.     set path "$HOME:HTML mode manual:HTMLmanual.html"
  1583.     if {$HTMLmodeVars(manualFolder) != ""} {set path "$HTMLmodeVars(manualFolder):HTMLmanual.html"}
  1584.     if {![file exists $path]} {
  1585.         if {![catch {htmlGetDir "Locate manual"} folder]} {
  1586.             set path "$folder:HTMLmanual.html"
  1587.             if {![file exists $path]} {
  1588.                 alertnote "Folder doesn't contain the HTML manual."
  1589.                 return
  1590.             }
  1591.             set HTMLmodeVars(manualFolder) $folder
  1592.             lappend modifiedModeVars {manualFolder HTMLmodeVars}
  1593.         } else {
  1594.             return
  1595.         }
  1596.     }
  1597.     htmlSendWindow $path
  1598. }
  1599.  
  1600. #
  1601. # launch a viewer and pass this window to it
  1602. #
  1603. proc htmlSendWindow {{path ""}} {
  1604.     global HTMLmodeVars browserSig
  1605.  
  1606.     if {$path == ""} {
  1607.         set path [stripNameCount [car [winNames -f]]]
  1608.  
  1609.         if {[winDirty]} {
  1610.             if {$HTMLmodeVars(saveWithoutAsking) || [set ask [askyesno -c "Save '[file tail $path]'?"]] == "yes"} {
  1611.                 save
  1612.             } elseif {$ask == "cancel"} {
  1613.                 return
  1614.             } elseif {![file exists $path]} {
  1615.                 alertnote "Can't send window to browser."
  1616.                 return
  1617.             }
  1618.         }
  1619.         # Get path again, in case it was Untitled before.
  1620.         set path [stripNameCount [car [winNames -f]]]
  1621.     }
  1622.     if {![info exists browserSig]} {set browserSig MOSS}
  1623.     set isRunning 0
  1624.     foreach    p [processes] {
  1625.         if {[lindex $p 1] == $browserSig } {
  1626.             set isRunning 1
  1627.         }
  1628.     }
  1629.     if {!$isRunning && [catch {launchBackAppl $browserSig}]} {
  1630.         getApplSig "Please locate your web browser" browserSig
  1631.         launchBackAppl $browserSig
  1632.     }
  1633.             
  1634.     sendOpenEvent noReply '$browserSig' $path
  1635.      if {$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1636. }
  1637.  
  1638.  
  1639. #===============================================================================
  1640. # Caches
  1641. #===============================================================================
  1642.  
  1643.  
  1644. proc htmlCleanUpCache {cache} {
  1645.     global HTMLmodeVars 
  1646.     global modifiedModeVars
  1647.     
  1648.     set URLs $HTMLmodeVars($cache)
  1649.  
  1650.     if {![llength $URLs]} {
  1651.         alertnote "No $cache are cached."
  1652.         return
  1653.     }
  1654.     set urlnumber [llength $URLs]
  1655.     set screenHeight [lindex [getMainDevice] 3]
  1656.     set maxLines [expr ($screenHeight - 160) / 20]
  1657.     set pages [expr ($urlnumber - 1) / $maxLines ]
  1658.     set thispage 0
  1659.     for {set i 0} {$i < $urlnumber} {incr i} {
  1660.         lappend URLsToSave 1
  1661.     }
  1662.     set thisbox $URLsToSave
  1663.     while {1} {
  1664.         if {$thispage < $pages} {
  1665.             set thisurlnumber $maxLines
  1666.         } else {
  1667.             set thisurlnumber [expr ($urlnumber - 1 ) % $maxLines + 1]
  1668.         }
  1669.         set height [expr 75 + $thisurlnumber  * 20]
  1670.         set box "-w 440 -h $height -b OK 20 [expr $height - 30]  85 [expr $height - 10] \
  1671.             -b Cancel 100 [expr $height - 30] 165 [expr $height - 10] \
  1672.             -b {Uncheck all} 180 [expr $height - 30] 265 [expr $height - 10] \
  1673.             -t {Uncheck the $cache you want to remove} 10 10 440 30 "
  1674.         if {$thispage < $pages} {
  1675.             lappend box -b "More…" 280 [expr $height - 30] 345 [expr $height - 10]
  1676.         }
  1677.         if {$thispage > 0} {
  1678.             lappend box -b "Back…" 360 [expr $height - 30] 425 [expr $height - 10]
  1679.         }
  1680.  
  1681.         set hpos 30 
  1682.         set thisURLs [lrange $URLs [expr $thispage * $maxLines] \
  1683.         [expr $thispage * $maxLines + $maxLines - 1]]
  1684.         set i 0
  1685.         foreach url $thisURLs {
  1686.             lappend box -c $url [lindex $thisbox $i] 10 $hpos 430 [expr $hpos + 15]
  1687.             incr i
  1688.             incr hpos 20
  1689.         }
  1690.         set thisbox [eval [concat dialog $box]]
  1691.         if {[lindex $thisbox 1]} {
  1692.             # cancel
  1693.             return
  1694.         } elseif {[lindex $thisbox 2]} {
  1695.             # uncheck all
  1696.             set thisbox {}
  1697.             for {set i 0} {$i < [llength $thisbox]} {incr i} {
  1698.                 lappend thisbox 0
  1699.             }
  1700.         } else {
  1701.             if {$pages == 0} {
  1702.                 set ll 3
  1703.             } elseif {$thispage == 0 || $thispage == $pages} {
  1704.                 set ll 4
  1705.             } else {
  1706.                 set ll 5
  1707.             }
  1708.             set URLsToSave [eval [concat lreplace [list $URLsToSave] [expr $thispage * $maxLines] \
  1709.             [expr $thispage * $maxLines + $maxLines - 1] [lrange $thisbox $ll end]]]
  1710.             if {[lindex $thisbox 0]} { 
  1711.                 # OK
  1712.                 break
  1713.             } elseif {$thispage < $pages && [lindex $thisbox 3]} { 
  1714.                 # more
  1715.                 incr thispage 1
  1716.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1717.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1718.             } else {
  1719.                 # back
  1720.                 incr thispage -1
  1721.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1722.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1723.             }
  1724.         }
  1725.     }
  1726.     set newurls {}
  1727.     for {set i 0} {$i < $urlnumber} {incr i} {
  1728.         if {[lindex $URLsToSave $i]} {
  1729.             lappend newurls [lindex $URLs $i]
  1730.         }
  1731.     }
  1732.     set HTMLmodeVars($cache) $newurls
  1733.     lappend modifiedModeVars [list $cache HTMLmodeVars]
  1734.     if {![llength $newurls]} {htmlEnable$cache off}
  1735. }
  1736.  
  1737. proc htmlSelScrapToURL {sel msg1 msg2} {
  1738.     set newurl [htmlURLunEscape [string trim [eval get$sel]]]
  1739.     # Convert tabs and returns.
  1740.     if {[regexp {[\t\r\n]} $newurl]} {
  1741.         alertnote "$msg1 contains tabs or returns. It will not be added to the URL cache."
  1742.         return
  1743.     }
  1744.     if {[string length $newurl]} {
  1745.         htmlAddToCache URLs $newurl
  1746.         message "$newurl added to URLs."
  1747.     } else {
  1748.         beep
  1749.         message $msg2
  1750.     }
  1751. }
  1752.  
  1753. proc htmlSelToURL {} {
  1754.     htmlSelScrapToURL Select Selection "No selection!"
  1755. }
  1756.  
  1757. proc htmlScrapToURL {} {
  1758.     htmlSelScrapToURL Scrap Clipboard "Clipboard empty!"
  1759. }
  1760.  
  1761. proc htmlClearCache {cache} {
  1762.     global HTMLmodeVars modifiedModeVars
  1763.     if {[askyesno "Remove all $cache from [string range $cache 0 [expr [string length $cache] - 2]] cache?"] == "yes"} {
  1764.         set HTMLmodeVars($cache) {}
  1765.         lappend modifiedModeVars [list $cache HTMLmodeVars]
  1766.         htmlEnable$cache off
  1767.     }
  1768. }
  1769.  
  1770. # Imports all URLs in a file to the cache.
  1771. proc htmlImportURL {} {
  1772.     global HTMLmodeVars modifiedModeVars htmlURLAttr
  1773.     set urls $HTMLmodeVars(URLs)
  1774.  
  1775.     if {[catch {getfile "Import URLs from:"} fil] || ![htmlIsTextFile $fil alertnote]} {return}
  1776.     set fid [open $fil r]
  1777.     set filecont " [read $fid]"
  1778.     close $fid
  1779.     if {[llength $urls]} {
  1780.         set cl [askyesno -c "Clear URL cache before importing?"]
  1781.         if {$cl == "cancel"} {
  1782.             return
  1783.         } elseif {$cl == "yes"} {
  1784.             set urls {}
  1785.         }
  1786.     }
  1787.             
  1788.     set exp "\[ \\t\\n\\r\]+("
  1789.     foreach attr $htmlURLAttr {
  1790.         append exp "$attr|"
  1791.     }
  1792.     set exp [string trimright $exp |]
  1793. #     append exp ")\"?(\[^ \\t\\n\\r\">\]+)\"?"
  1794.     append exp ")(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  1795.     while {[regexp -nocase -indices $exp $filecont a b url]} {
  1796.         set link [string range $filecont [lindex $url 0] [lindex $url 1]]
  1797.         set filecont [string range $filecont [lindex $url 1] end]
  1798.         if {[lsearch -exact $urls $link] < 0} {
  1799.             lappend urls [htmlURLunEscape [string trim $link \"]]
  1800.         }
  1801.     }
  1802.     set HTMLmodeVars(URLs) [lsort $urls]
  1803.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1804.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1805.     message "URLs imported."
  1806. }
  1807.  
  1808. # Export URLs in cache to a file.
  1809. proc htmlExportURL {} {
  1810.     global HTMLmodeVars
  1811.     if {![llength $HTMLmodeVars(URLs)]} {
  1812.         alertnote "URL cache is empty."
  1813.         return
  1814.     }
  1815.     foreach url $HTMLmodeVars(URLs) {
  1816.         lappend out "HREF=\"$url\""
  1817.     }
  1818.     if {![catch {putfile "Export URL cache to:" "URL cache"} fil]} {
  1819.         if {[file exists $fil]} {removeFile $fil}
  1820.         set fid [open $fil w]
  1821.         puts $fid [join $out "\n"]
  1822.         close $fid
  1823.         message "URLs exported."
  1824.     }
  1825. }
  1826.  
  1827. # Add all files in a folder to URL cache.
  1828. proc htmlFolderToURL {} {
  1829.     global HTMLmodeVars modifiedModeVars
  1830.     if {[catch {htmlGetDir "Folder to cache:"} folder]} {return}
  1831.     set path ""
  1832.     foreach hp $HTMLmodeVars(homePages) {
  1833.         if {[string match "[lindex $hp 0]:*" "$folder:"]} {
  1834.             set path [string range $folder [expr [string length [lindex $hp 0]] +1] end]
  1835.             regsub -all {:} $path {/} path
  1836.             if {[string length $path]} {append path /}
  1837.         }
  1838.     }
  1839.     set val [dialog -w 350 -h 80 -t "Path:" 10 10 60 30 -e $path 70 10 340 25 \
  1840.     -b OK 20 50 85 70 -b Cancel 110 50 175 70]
  1841.     if {[lindex $val 2]} {return}
  1842.     set path [string trim [lindex $val 0]]
  1843.     if {[string length $path]} {set path "[string trimright $path /]/"}
  1844.     set urls $HTMLmodeVars(URLs)
  1845.     if {[llength $urls]} {
  1846.         set cl [askyesno -c "Clear URL cache first?"]
  1847.         if {$cl == "cancel"} {
  1848.             return
  1849.         } elseif {$cl == "yes"} {
  1850.             set urls {}
  1851.         }
  1852.     }
  1853.  
  1854.     foreach fil [glob -nocomplain "$folder:*"] {
  1855.         set name [file tail $fil]
  1856.         if {![file isdirectory $fil] && [lsearch -exact $urls "$path$name"] < 0} {
  1857.             lappend urls "$path$name"
  1858.         }
  1859.     }
  1860.     set HTMLmodeVars(URLs) [lsort $urls]
  1861.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1862.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1863.     message "Files added to URL cache."
  1864. }
  1865.  
  1866.  
  1867. #==============================================================================
  1868. #    Colors
  1869. #==============================================================================
  1870.  
  1871. # Convert colour names to numbers and vice versa.
  1872. # Or brings up a color picker if cmd-doubleClick.
  1873. proc htmlRevealColor {{dblClick 0}} {
  1874.     global htmlColorName htmlColorNumber htmlColorAttr htmluserColors 
  1875.     global htmluserColorname
  1876.  
  1877.     set searchstring "("
  1878.     foreach s $htmlColorAttr {
  1879.         append searchstring "${s}|"
  1880.     } 
  1881.     # remove last |
  1882.     set searchstring [string trimright $searchstring |]
  1883.     append searchstring ")((\[^ \\t\\r\">\]+)|\"(\[^\"\]+)\")"
  1884.     set startpos [getPos]
  1885.     set endpos [selEnd]
  1886.     set cantfind 0
  1887.     # find attribute
  1888.     set f [search -s -f 0 -r 1 -i 1 -n -m 0 $searchstring $startpos]
  1889.     if {![string length $f] || [lindex $f 1] < $endpos} {
  1890.         set cantfind 1
  1891.     }
  1892.     if {!$cantfind} {
  1893.         set txt [getText [lindex $f 0] [lindex $f 1]]
  1894.         regexp -indices -nocase $searchstring $txt a b c
  1895.         set cpos [expr [lindex $f 0] + [lindex $c 0]]
  1896.         set epos [expr [lindex $f 0] + [lindex $c 1] + 1]
  1897.         set col [string trim [string range $txt [lindex $c 0] [lindex $c 1]] \"]
  1898.         if {!$dblClick} {
  1899.             if {[info exists htmlColorName($col)]} {
  1900.                 replaceText $cpos $epos "\"$htmlColorName($col)\""
  1901.             } elseif {[info exists htmlColorNumber($col)]} {
  1902.                 replaceText $cpos $epos "\"$htmlColorNumber($col)\""
  1903.             } elseif {[info exists htmluserColorname($col)]} {
  1904.                 replaceText $cpos $epos "\"$htmluserColorname($col)\""
  1905.             } elseif {[info exists htmluserColors($col)]} {
  1906.                 replaceText $cpos $epos "\"$htmluserColors($col)\""
  1907.             } else {
  1908.                 beep
  1909.                 message "Don't recognize color."
  1910.             }
  1911.         } else {
  1912.             if {[set ncol [htmlCheckColorNumber $col]] != "0"} {
  1913.                 set ncol [htmlHexColor $ncol]
  1914.             } else {
  1915.                 set ncol {65535 65535 65535}
  1916.             }
  1917.             set newcolor [eval [concat colorTriple {{Change color}} $ncol]]
  1918.             if {[string length $newcolor]} {
  1919.                 replaceText $cpos $epos "\"[htmlColorHex $newcolor]\""
  1920.             }
  1921.             return 1
  1922.         }
  1923.     } elseif {!$dblClick} {
  1924.         beep
  1925.         message "Current position is not at a color attribute."
  1926.     } else {
  1927.         return 0
  1928.     }
  1929. }
  1930.  
  1931. # Dialog to handle colors.
  1932. proc htmlColors {} {
  1933.     global htmluserColors
  1934.  
  1935.     set this ∞
  1936.     while {1} {
  1937.         set colors [lsort [array names htmluserColors]]
  1938.         set box "-t {Colors:} 10 10 80 30 \
  1939.         -t Number: 10 50 80 70 \
  1940.         -b Done 10 100 75 120 -b New 90 100 155 120 -b {New by number} 250 10 370 30"
  1941.         if {[llength $colors]} {
  1942.             append box " -m [list [concat [list $this] $colors]] 90 10 230 30"
  1943.             append box " -b Change 170 100 235 120 -b Remove 250 100 315 120 \
  1944.             -b {Change number} 250 40 370 60 -b View 250 70 315 90"
  1945.             foreach c $colors {
  1946.                 lappend box -n $c -t $htmluserColors($c) 90 50 160 90
  1947.             }
  1948.         } else {
  1949.             append box  " -m {{None defined} {None defined}} 90 10 230 30"
  1950.         }
  1951.         set values [eval [concat dialog -w 380 -h 130 $box]]
  1952.         set this [lindex $values 3]
  1953.         if {[lindex $values 0]} {
  1954.             return
  1955.         } elseif {[lindex $values 1]} {
  1956.             set newc [htmlAddNewColor]
  1957.             if {[string length $newc]} {set this $newc}
  1958.         } elseif {[lindex $values 2]} {
  1959.             set newc [htmlNameColor "" "Color saved." "" ""]
  1960.             if {[string length $newc]} {set this $newc}
  1961.         } elseif {[lindex $values 4]} {
  1962.             set newcolor [eval [concat colorTriple [list $this] [htmlHexColor $htmluserColors($this)]]]
  1963.             if {![string length $newcolor]} {continue}
  1964.             set newc [htmlNameColor [htmlColorHex $newcolor] "Color changed." $this $htmluserColors($this)]
  1965.             if {[string length $newc]} {set this $newc}        
  1966.         } elseif {[lindex $values 5]} {
  1967.             if {[askyesno "Remove $this?"] == "yes"} {
  1968.                 htmlColordelete $this $htmluserColors($this)
  1969.                 message "Color removed."
  1970.             }
  1971.         } elseif {[lindex $values 6]} {
  1972.             set newc [htmlNameColor "" "Color changed." $this $htmluserColors($this)]
  1973.             if {[string length $newc]} {set this $newc}        
  1974.         } else {
  1975.             eval [concat colorTriple [list $this] [htmlHexColor $htmluserColors($this)]]
  1976.         }
  1977.     }
  1978. }
  1979.  
  1980. # Checks if colornumber is identical to another colour.
  1981. proc htmlColorIdentical {colornumber changeColor} {
  1982.     global htmlColorNumber htmluserColorname
  1983.     if {( ![catch {set colTest $htmlColorNumber($colornumber)}] || \
  1984.     ![catch {set colTest $htmluserColorname($colornumber)}] ) && \
  1985.     $colTest != $changeColor} {
  1986.         alertnote "This color is identical with '$colTest'. Two identical \
  1987.         colors cannot be defined."
  1988.         return 1
  1989.     }
  1990.     return 0
  1991. }
  1992.  
  1993. # Converts a red green blue number to hex.
  1994. proc htmlColorHex {color} {
  1995.     set hexa {A B C D E F}
  1996.     
  1997.     set red [expr round([lindex $color 0] / 256.0)]
  1998.     set green [expr round([lindex $color 1] / 256.0)]
  1999.     set blue [expr round([lindex $color 2] / 256.0)]
  2000.     set cols [list [expr $red / 16] [expr $red % 16] [expr $green / 16] [expr $green % 16] [expr $blue / 16] [expr $blue % 16]]
  2001.     set colornumber {#}
  2002.     foreach c $cols {
  2003.         if {$c > 9} {
  2004.             set c1 [lindex $hexa [expr $c - 10]]
  2005.         } else {
  2006.             set c1 $c
  2007.         }
  2008.         append colornumber $c1
  2009.     }
  2010.     return $colornumber
  2011. }
  2012.  
  2013. # Converts a hex number to red green blue.
  2014. proc htmlHexColor {number} {
  2015.     foreach c [split [string range $number 1 end] ""] {
  2016.         switch $c {
  2017.             A    {set c1 10}
  2018.             B    {set c1 11}
  2019.             C    {set c1 12}
  2020.             D    {set c1 13}
  2021.             E    {set c1 14}
  2022.             F    {set c1 15}
  2023.             default {set c1 $c}
  2024.         }
  2025.         lappend numbers $c1
  2026.     }
  2027.     set red [expr [lindex $numbers 0] * 4096 + [lindex $numbers 1] * 256]
  2028.     set green [expr [lindex $numbers 2] * 4096 + [lindex $numbers 3] * 256]
  2029.     set blue [expr [lindex $numbers 4] * 4096 + [lindex $numbers 5] * 256]
  2030.     return [list $red $green $blue]
  2031. }    
  2032.  
  2033. proc htmlAddNewColor {} {
  2034.     set newcolor [colorTriple "New color"]    
  2035.     if {![string length $newcolor]} {return }
  2036.     return [htmlNameColor [htmlColorHex $newcolor] "Color saved." "" ""]
  2037. }
  2038.  
  2039. proc htmlNameColor {colornumber msg changeColor changeNumber} {
  2040.     global htmluserColors basicColors
  2041.     set alluserColors [array names htmluserColors]
  2042.     set noname 1
  2043.     set picker [string length $colornumber]
  2044.     set values [list $changeColor $changeNumber]
  2045.     while {$noname} {
  2046.         if {!$picker} {
  2047.             if {[string length $changeColor]} {
  2048.                 set ttt Change
  2049.             } else {
  2050.                 set ttt New
  2051.             }
  2052.             set values [dialog -w 300 -h 150 -t "$ttt color" 50 10 250 30 \
  2053.             -t "Name:" 10 45 75 65 -e [lindex $values 0] 80 45 290 60 \
  2054.             -t "Number:" 10 75 75 95 -e [lindex $values 1] 80 75 150 90 \
  2055.             -b OK 20 120 85 140 -b Cancel 110 120 175 140]
  2056.             
  2057.             if {[lindex $values 3]} {return}
  2058.             set colorname [string trim [lindex $values 0]]
  2059.             set colornumber [string trim [lindex $values 1]]
  2060.             set coltest [htmlCheckColorNumber $colornumber]
  2061.             if {$coltest == "0"} {
  2062.                 alertnote "$colornumber is not a valid color number. It should be of the form #RRBBGG."
  2063.                 continue
  2064.             }
  2065.             set colornumber $coltest
  2066.             if {[htmlColorIdentical $colornumber $changeColor]} {return}
  2067.         } else {
  2068.             if {[htmlColorIdentical $colornumber $changeColor]} {return}
  2069.             if {[catch {prompt "Color name" $changeColor} colorname]} { 
  2070.                 # cancel
  2071.                 return
  2072.             }
  2073.             set colorname [string trim $colorname]
  2074.         }
  2075.         if {[lsearch -exact $basicColors $colorname] >= 0} {
  2076.             alertnote "Predefined color. Choose another name."
  2077.         } elseif {[string length $colorname]} {
  2078.             set replace 0
  2079.             if {[lsearch -exact $alluserColors $colorname] >= 0 && \
  2080.             $colorname != $changeColor} {
  2081.                 set repl [dialog -w 200 -h 75 -b Cancel 20 40 80 60 \
  2082.                 -b Replace 115 40 175 60 \
  2083.                 -t "Replace $colorname?" 10 10 150 30]
  2084.                 if {[lindex $repl 1] } { 
  2085.                     set replace 1
  2086.                     # remove the color first 
  2087.                     set oldnumber $htmluserColors($colorname)
  2088.                     htmlColordelete $colorname $oldnumber
  2089.                 }
  2090.             } else {
  2091.                 set replace 1
  2092.             }
  2093.             # add the new color
  2094.             if {$replace} { 
  2095.                 if {[string length $changeColor]} {
  2096.                     htmlColordelete $changeColor $changeNumber
  2097.                 }
  2098.                 set noname 0
  2099.                 htmlColordef $colorname $colornumber
  2100.                 message $msg
  2101.             }
  2102.         } else {
  2103.             alertnote "You must name the color."
  2104.         }
  2105.     }
  2106.     return $colorname
  2107. }
  2108.  
  2109.  
  2110. proc htmlColordef {colorname colornumber} {
  2111.     global htmluserColors htmluserColorname
  2112.     
  2113.     set htmluserColors($colorname) $colornumber
  2114.     set htmluserColorname($colornumber) $colorname
  2115.     addArrDef htmluserColors $colorname $colornumber
  2116.     addArrDef htmluserColorname $colornumber $colorname
  2117. }
  2118.  
  2119. proc htmlColordelete {colorname colornumber} {
  2120.     global htmluserColors htmluserColorname
  2121.     
  2122.     catch {unset htmluserColors($colorname)}
  2123.     catch {unset htmluserColorname($colornumber)}
  2124.     removeArrDef htmluserColors $colorname
  2125.     removeArrDef htmluserColorname $colornumber
  2126. }
  2127.  
  2128. #===============================================================================
  2129. #  Home pages
  2130. #===============================================================================
  2131.  
  2132. # Dialog to handle servers and corresponding home page folders.
  2133. proc htmlHomePages {{this ""}} {
  2134.     global modifiedModeVars HTMLmodeVars
  2135.     
  2136.     set pages $HTMLmodeVars(homePages)
  2137.     set touchedIt 0
  2138.     if {$this == ""} {set this ∞}
  2139.     while {1} {
  2140.         set box "-t {Home pages} 180 10 300 30 -t {Server URLs:} 10 40 100 60 \
  2141.         -t {Home Page Folder:} 10 70 110 110 \
  2142.         -t {Include Folder:} 10 120 110 140 -t {Default file:} 12 170 100 190 \
  2143.         -b OK 10 200 75 220 -b Cancel 90 200 155 220 -b New 170 200 235 220\
  2144.         -c {Tell Big Brother} 0 320 170 440 190"
  2145.         if {[llength $pages]} {
  2146.             set pgs ""
  2147.             foreach pg $pages {
  2148.                 lappend pgs "[lindex $pg 1][lindex $pg 2]"
  2149.             }
  2150.             append box " -m [list [concat $this $pgs]] 110 40 440 60"
  2151.             append box " -b Change 250 200 315 220 -b Remove 330 200 395 220"
  2152.             foreach pg $pages {
  2153.                 lappend box -n "[lindex $pg 1][lindex $pg 2]" -t [lindex $pg 0] 120 70 440 110 \
  2154.                 -t [lindex $pg 3] 110 170 310 190
  2155.                 if {[llength $pg] == 5} {lappend box -t [lindex $pg 4] 120 120 440 160}
  2156.             }
  2157.         } else {
  2158.             append box  " -m {{None defined} {None defined}} 110 40 440 60"
  2159.         }
  2160.         set values [eval [concat dialog -w 450 -h 230 $box]]
  2161.         set this [lindex $values 4]
  2162.         if {[lindex $values 0]} {
  2163.             set HTMLmodeVars(homePages) $pages
  2164.             lappend modifiedModeVars {homePages HTMLmodeVars}
  2165.             if {[lindex $values 3] && [askyesno "Change URL mappings in Big Brother?"] == "yes"} {
  2166.                 if {[catch {file tail [launchBackAppl Bbth]} name]} {
  2167.                     alertnote "Could not find or launch Big Brother."
  2168.                     return
  2169.                 }
  2170.                 set allSettings [AEBuild -r $name core getd ---- "obj{want:type('reco'),from:null(),form:'prop',seld:type('allS')}"]
  2171.                 if {[regexp {mapS:} $allSettings]} {
  2172.                     set urlmap [htmlURLmap]
  2173.                     AEBuild $name core setd "----" "obj{want:type('mapG'),from:null(),form:'prop',seld:type('mapS')}" "data" "\[$urlmap\]"
  2174.                 } else {
  2175.                     alertnote "Cannot change the settings in Big Brother. You need Big Brother 1.1 or later."
  2176.                 }
  2177.             }
  2178.             return
  2179.         } elseif {[lindex $values 1]} {
  2180.             if {!$touchedIt || [askyesno "Really cancel without saving changes?"] == "yes"} {return}
  2181.         } elseif {[lindex $values 2]} {
  2182.             set newpg {{} {} {} "index.html" {}}
  2183.             while {1} {
  2184.                 if {[catch {htmlSetHomePages $pages [lindex $newpg 0] "[lindex $newpg 1][lindex $newpg 2]" [lindex $newpg 3] [lindex $newpg 4]} newpg]} {break}
  2185.                 if {[htmlTestHomePage $pages $newpg]} {
  2186.                     lappend pages $newpg
  2187.                     set this "[lindex $newpg 1][lindex $newpg 2]"
  2188.                     set touchedIt 1
  2189.                     break
  2190.                 }
  2191.             }
  2192.         } else {
  2193.             for {set i 0} {$i < [llength $pages]} {incr i} {
  2194.                 if {"[lindex [lindex $pages $i] 1][lindex [lindex $pages $i] 2]" == $this} {
  2195.                     if {[lindex $values 5]} {
  2196.                         set newpg [lindex $pages $i]
  2197.                         set pg "[lindex $newpg 1][lindex $newpg 2]"
  2198.                         while {1} {
  2199.                             if {[catch {htmlSetHomePages $pages [lindex $newpg 0] "[lindex $newpg 1][lindex $newpg 2]" [lindex $newpg 3] [lindex $newpg 4] $pg} newpg]} {break}
  2200.                             if {[htmlTestHomePage $pages $newpg $pg]} {
  2201.                                 set pages [lreplace $pages $i $i $newpg]
  2202.                                 set this "[lindex $newpg 1][lindex $newpg 2]"
  2203.                                 set touchedIt 1
  2204.                                 break
  2205.                             }
  2206.                         }
  2207.                     } else {
  2208.                         set pages [lreplace $pages $i $i]
  2209.                         set touchedIt 1
  2210.                     }
  2211.                 }
  2212.             }
  2213.         }
  2214.     }    
  2215. }
  2216.  
  2217. # Dialog to define or change a home page.
  2218. proc htmlSetHomePages {pages folder url defFile inclFld {pg ""}} {
  2219.  
  2220.     while {1} {    
  2221.         set val [dialog -w 450 -h 205 -t "Home Page Folder:" 10 10 135 30 -t $folder 140 10 440 50 \
  2222.         -t "Include Folder:" 10 60 110 80 -t $inclFld 130 60 440 100 \
  2223.         -t "Server URL:" 10 110 90 130 \
  2224.         -e $url 100 110 440 125 -t "Default file:" 10 145 90 160 \
  2225.         -e $defFile 100 145 440 160 -b OK 20 175 85 195 -b Cancel 110 175 175 195 \
  2226.         -b "Set…" 20 30 80 50 -b "Set…" 10 80 60 100 -b "Unset" 70 80 120 100]
  2227.         set url [string trim [lindex $val 0]]
  2228.         set defFile [string trim [lindex $val 1]]
  2229.         if {[lindex $val 4] && ![catch {htmlGetAhpFolder "Home Page Folder:" $pages $pg} fld]} {
  2230.             set folder $fld
  2231.         } elseif {[lindex $val 5] && ![catch {htmlGetAhpFolder "Include Folder:" $pages $pg} fld]} {
  2232.             set inclFld $fld
  2233.         } elseif {[lindex $val 6]} {
  2234.             set inclFld ""
  2235.         } elseif {[lindex $val 2]} {
  2236.             if {![regexp {://} $url]} {
  2237.                 alertnote "The server URL can't be a relative URL."
  2238.             } elseif {[string length $folder] && [string length $url] && [string length $defFile]} {
  2239.                 regexp -indices {://} $url css
  2240.                 set sl [string first / [string range $url [expr [lindex $css 1] + 1] end]]
  2241.                 if {$sl < 0} {
  2242.                     set base "$url/"
  2243.                     set path ""
  2244.                 } elseif {[string index $url [expr [string length $url] -1]] != "/"} {
  2245.                     alertnote "A directory URL ending with a slash expected."
  2246.                     continue
  2247.                 } else {
  2248.                     set base [string range $url 0 [expr [lindex $css 1] + $sl + 1]]
  2249.                     set path [string range $url [expr [lindex $css 1] + $sl + 2] end]
  2250.                 }
  2251.                 set ret [list $folder $base $path $defFile]
  2252.                 if {$inclFld != ""} {lappend ret $inclFld}
  2253.                 return  $ret
  2254.             } else {
  2255.                 alertnote "Everything must be specified except the include folder."
  2256.             }
  2257.         } elseif {[lindex $val 3]} {
  2258.             error ""
  2259.         }
  2260.     }
  2261. }
  2262.  
  2263. proc htmlTestHomePage {pages newpg {pg ""}} {
  2264.     foreach p $pages {
  2265.         if {"[lindex $p 1][lindex $p 2]" == $pg} {continue}
  2266.         if {[string match "[lindex $p 1][lindex $p 2]*" "[lindex $newpg 1][lindex $newpg 2]"] ||
  2267.         [string match "[lindex $newpg 1][lindex $newpg 2]*" "[lindex $p 1][lindex $p 2]"]} {
  2268.             alertnote "There is already a home page folder for [lindex $p 1][lindex $p 2].\
  2269.             It overlaps with this one."
  2270.             return 0
  2271.         }
  2272.     }
  2273.     return 1
  2274. }    
  2275.  
  2276. proc htmlGetAhpFolder {txt pages pg} {
  2277.     set fld [htmlGetDir $txt]
  2278.     set msg {"home page" "" "" "" include}
  2279.     foreach p $pages {
  2280.         foreach i {0 4} {
  2281.             if {"[lindex $p 1][lindex $p 2]" == $pg && [regexp -nocase [lindex $msg $i] $txt]
  2282.             || [llength $p] == $i} {continue}
  2283.             if {[string match "[lindex $p $i]:*" "$fld:"] || [string match "$fld:*" "[lindex $p $i]:"]} {
  2284.                 alertnote "This folder overlaps with the [lindex $msg $i] folder for [lindex $p 1][lindex $p 2]."
  2285.                 error ""
  2286.             }
  2287.         }
  2288.     }
  2289.     return $fld
  2290. }
  2291.  
  2292.  
  2293. #===============================================================================
  2294. #  Footers
  2295. #===============================================================================
  2296.  
  2297. proc htmlFooters {} {
  2298.     global HTMLmodeVars modifiedModeVars
  2299.     
  2300.     set footers [lsort $HTMLmodeVars(footers)]
  2301.     set touchedIt 0
  2302.     set this ∞
  2303.     while {1} {
  2304.         set box "-t {Footers:} 10 10 80 30 \
  2305.         -t Path: 30 50 80 70 \
  2306.         -b OK 10 110 75 130 -b Cancel 90 110 155 130 -b New 170 110 235 130"
  2307.         if {[llength $footers]} {
  2308.             set foot ""
  2309.             foreach f $footers {
  2310.                 lappend foot [file tail $f]
  2311.             }
  2312.             append box " -m [list [concat [list $this] $foot]] 90 10 440 30"
  2313.             append box " -b Remove 250 110 315 130 -b Insert 330 110 395 130"
  2314.             foreach f $footers {
  2315.                 lappend box -n [file tail $f] -t $f 90 50 440 90
  2316.             }
  2317.         } else {
  2318.             append box  " -m {{None defined} {None defined}} 90 10 440 30"
  2319.         }
  2320.         set values [eval [concat dialog -w 450 -h 140 $box]]
  2321.         set this [lindex $values 3]
  2322.         if {[lindex $values 0]} {
  2323.             set HTMLmodeVars(footers) $footers
  2324.             lappend modifiedModeVars {footers HTMLmodeVars}
  2325.             return
  2326.         } elseif {[lindex $values 1]} {
  2327.             if {!$touchedIt || [askyesno "Really cancel without saving changes?"] == "yes"} {return}
  2328.         } elseif {[lindex $values 2]} {
  2329.             if {![catch {htmlNewFooter $footers} newfoot]} {
  2330.                 lappend footers $newfoot
  2331.                 set footers [lsort $footers]
  2332.                 set this [file tail $newfoot]
  2333.                 set touchedIt 1
  2334.             }
  2335.         } else {
  2336.             set i [lsearch -exact $foot $this]
  2337.             set footerFile [lindex $footers $i]
  2338.             if {[lindex $values 5]} {
  2339.                 if {![catch {readFile $footerFile} footText]} {
  2340.                     insertText "\r$footText\r"
  2341.                     set HTMLmodeVars(footers) $footers
  2342.                     lappend modifiedModeVars {footers HTMLmodeVars}
  2343.                     message "$this inserted."
  2344.                     return
  2345.                 } else {
  2346.                     alertnote "Could not read $this."
  2347.                 }
  2348.             } else {
  2349.                 set footers [lreplace $footers $i $i]
  2350.                 set touchedIt 1
  2351.             }
  2352.         }
  2353.     }    
  2354. }
  2355.  
  2356. # Define a file as a footer.
  2357. proc htmlNewFooter {footers} {
  2358.     set newFooter [getfile "Select the file with the footer."]
  2359.     if {![htmlIsTextFile $newFooter alertnote]} {
  2360.         error ""
  2361.     } elseif {[lsearch -exact $footers $newFooter] < 0} {
  2362.         # Can't define two footers with the same file name.
  2363.         foreach f $footers {
  2364.             if {[file tail $f] == [file tail $newFooter]} {
  2365.                 alertnote "There is already a footer with the filename\
  2366.                 '[file tail $newFooter]'. Two footers with the same filename\
  2367.                 cannot be defined."
  2368.                 error ""
  2369.             }
  2370.         }
  2371.         return $newFooter
  2372.     } else {
  2373.         alertnote "'[file tail $newFooter]' already a footer."
  2374.         error ""
  2375.     }
  2376. }
  2377.  
  2378.  
  2379. #===============================================================================
  2380. # Last modified
  2381. #===============================================================================
  2382.  
  2383. proc htmlInsertLastMod {} {
  2384.     set values [dialog -w 300 -h 190 -t "Last modified tags" 40 10 200 30 \
  2385.     -e "Last modified" 10 40 290 55 -t "Date format" 10 70 100 90 \
  2386.     -r "Long" 1 10 95 70 115 -r "Abbreviated" 0 80 95 180 115 -r "Short" 0 190 95 250 115 \
  2387.     -c "Include weekday" 0 10 120 150 140 -c "Include time" 0 160 120 290 140 \
  2388.     -b OK 20 160 85 180 -b Cancel 110 160 175 180]
  2389.     if {[lindex $values 7]} {return}
  2390.     set lm [htmlQuote [lindex $values 0]]
  2391.     set text "<!-- [htmlSetCase "#LASTMODIFIED TEXT"]=\"$lm\" [htmlSetCase FORM]=\""
  2392.     if {[lindex $values 1]} {append text [htmlSetCase LONG]}
  2393.     if {[lindex $values 2]} {append text [htmlSetCase ABBREV]}
  2394.     if {[lindex $values 3]} {append text [htmlSetCase SHORT]}
  2395.     if {[lindex $values 4]} {append text [htmlSetCase ",WEEKDAY"]}
  2396.     if {[lindex $values 5]} {append text [htmlSetCase ",TIME"]}
  2397.     append text "\" -->"
  2398.     set text "$text\r[htmlGetLastMod $text]\r<!-- [htmlSetCase /#LASTMODIFIED] -->"
  2399.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res] &&
  2400.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  2401.         if {[askyesno "There are already 'last modified' tags in this document. Replace them?"] == "yes"} {
  2402.             replaceText [lindex $res 0] [lindex $res2 1] $text
  2403.         }
  2404.     } else {
  2405.         insertText [htmlOpenCR 1] $text "\r\r"
  2406.     }
  2407. }
  2408.  
  2409. proc htmlLastModified {name} {
  2410.     if {[lindex [winNames -f] 0] != $name} {bringToFront $name}
  2411.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res]} {
  2412.         if {[catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  2413.             alertnote "The window '[file tail $name]' contains an opening 'last modified' tag without a matching closing tag."
  2414.             return
  2415.         }
  2416.         set str [htmlGetLastMod [getText [lindex $res 0] [expr [lindex $res 1] + 1]]]
  2417.         if {$str == "0"} {
  2418.             alertnote "The window '[file tail $name]' contains invalid 'last modified' tags."
  2419.         } else {
  2420.             replaceText [lindex $res 1] [lindex $res2 0] "\r" $str "\r"
  2421.         }
  2422.     }
  2423. }
  2424.  
  2425. proc htmlGetLastMod {str} {
  2426.     global htmlSpecialCharacter htmlSpecialCapCharacter
  2427.     set text ""
  2428.     set form ""
  2429.     set type ""
  2430.     if {![regexp -nocase {TEXT=\"([^\"]*)\"} $str dum text] ||
  2431.     ![regexp -nocase {FORM=\"([^\"]*)\"} $str dum form] || $form == "" ||
  2432.     ![regexp -nocase {[^,]*} $form type] || 
  2433.     [lsearch -exact [list LONG ABBREV SHORT] [string toupper $type]] < 0} {return 0}
  2434.     set text [htmlUnQuote $text]
  2435.     set day [string match "*WEEKDAY*" [string toupper $form]]
  2436.     set tid [string match "*TIME*" [string toupper $form]]
  2437.     set date [mtime [now] [string tolower $type]]
  2438.     if {!$day && [string toupper $type] != "SHORT"} {
  2439.         set date [lreplace $date 0 0 [lrange [lindex $date 0] 1 end]]
  2440.     }
  2441.     if {!$tid} {
  2442.         set date [lindex $date 0]
  2443.     } else {
  2444.         set tiden [lindex $date 1]
  2445.         regexp {^[0-9]+[^0-9]+[0-9]+} $tiden tidstr
  2446.         set tiden [lreplace $tiden 0 0 $tidstr]
  2447.         set date [lreplace $date 1 1 $tiden]
  2448.     }
  2449.     set text "$text [join $date]"
  2450.     regsub -all "&" $text "\\&" text
  2451.     regsub -all "<" $text "\\<" text
  2452.     regsub -all ">" $text "\\>" text
  2453.     regsub -all "¿" $text "\\¿" text
  2454.     regsub -all "¡" $text "\\¡" text
  2455.     foreach c [array names htmlSpecialCharacter] {
  2456.         regsub -all $c $text "\\&$htmlSpecialCharacter($c);" text
  2457.     }
  2458.     foreach c [array names htmlSpecialCapCharacter] {
  2459.         regsub -all $c $text "\\&$htmlSpecialCapCharacter($c);" text
  2460.     }
  2461.     foreach c [list eth ETH thorn THORN] {
  2462.         regsub -all "&$c;" $text $c text
  2463.     }
  2464.     return $text
  2465. }
  2466.  
  2467. #===============================================================================
  2468. # Includes
  2469. #===============================================================================
  2470.  
  2471. # Inserts new include tags at the current position.
  2472. proc htmlNewInclude {} {
  2473.     set sexpr {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>}
  2474.     set eexpr {<!--[ \t\r\n]+/#INCLUDE[ \t\r\n]+[^>]+>}
  2475.     if {![catch {search -s -f 0 -r 1 -i 1 -m 0 $sexpr [getPos]} res] &&
  2476.         ([catch {search -s -f 0 -r 1 -i 1 -m 0 $eexpr [getPos]} res1]
  2477.         || [lindex $res 0] > [lindex $res1 0])} {
  2478.         alertnote "Current position is inside an include container."
  2479.         return
  2480.     }
  2481.     if {![catch {search -s -f 1 -r 1 -i 1 -m 0 $eexpr [getPos]} res] &&
  2482.         ([catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr [getPos]} res1]
  2483.         || [lindex $res 0] < [lindex $res1 0])} {
  2484.         alertnote "Current position is inside an include container."
  2485.         return
  2486.     }
  2487.     if {[catch {getfile "Select file to include."} fil]} {return}
  2488.     if {![htmlIsTextFile $fil alertnote]} {return}
  2489.     set fil1 [htmlQuote $fil]
  2490.     set text "<!-- [htmlSetCase {#INCLUDE FILE=}]\"$fil1\" -->\r\r"
  2491.     if {![catch {readFile $fil} intext]} {
  2492.         regsub -all "\n\r" $intext "\r" intext
  2493.         # Remove include tags from inserted text
  2494.         regsub -all -nocase $sexpr $intext "" intext
  2495.         regsub -all -nocase $eexpr $intext "" intext
  2496.         append text $intext
  2497.     }
  2498.     append text "\r\r" "<!-- [htmlSetCase /#INCLUDE] -->"
  2499.     insertText [htmlOpenCR 1] $text "\r\r"
  2500. }
  2501.  
  2502. # Updates the text between all include tags.
  2503. proc htmlUpdateInclude {where} {
  2504.     global HTMLmodeVars winModes
  2505.     global tileLeft tileTop tileWidth errorHeight
  2506.     
  2507.     set sexpr {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>}
  2508.     set eexpr {<!--[ \t\r\n]+/#INCLUDE[ \t\r\n]+[^>]+>}
  2509.     if {$where == "Window"} {
  2510.         set wname [lindex [winNames] 0]
  2511.         set pos 0
  2512.         while {![catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr $pos} res]} {
  2513.             set lnum [lindex [posToRowCol [lindex $res 0]] 0]
  2514.             set ln [expr 5 - [string length $lnum]]
  2515.             if {[catch {search -s -f 1 -r 1 -i 1 -m 0 $eexpr [lindex $res 1]} res1]} {
  2516.                 append err "Line $lnum:[format "%$ln\s" ""]Opening include tag without a matching end tag."\
  2517.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"
  2518.                 break
  2519.             }
  2520.             if {![catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr [lindex $res 1]} res2]
  2521.             && [lindex $res2 0] < [lindex $res1 0]} {
  2522.                 append err "Line $lnum:[format "%$ln\s" ""]Nested include tags."\
  2523.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"
  2524.                 set pos [lindex $res1 1]
  2525.                 continue
  2526.             }    
  2527.             if {[catch {htmlReadInclude [getText [lindex $res 0] [lindex $res 1]] 1} text]} {
  2528.                 append err "Line $lnum:[format "%$ln\s" ""]$text"\
  2529.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"
  2530.                 set pos [lindex $res1 1]
  2531.             } else {
  2532.                 replaceText [lindex $res 1] [lindex $res1 0] "\r\r" $text "\r\r"
  2533.                 set pos [expr [lindex $res 1] + [string length $text] + 4]
  2534.             }
  2535.         }
  2536.     } else {
  2537.         if {[htmlAllSaved "-c {Save all open windows before updating?}"] == "cancel"} {return}
  2538.         if {$where == "File"} {
  2539.             if {[catch {getfile "Select file to update."} files]} {return}
  2540.             if {![htmlIsTextFile $files alertnote]} {return}
  2541.             set folder [file tail $files]
  2542.             set files [list $files]
  2543.         } elseif {$where == "Folder"} {
  2544.             if {[catch {htmlGetDir "Update folder:"} folder]} {return}
  2545.             set subFolders [expr ![string compare yes [askyesno "Update files in subfolders?"]]]
  2546.             if {$subFolders} {
  2547.                 set files [htmlAllHTMLfiles $folder]
  2548.             } else {
  2549.                 set files [htmlGetHTMLfiles $folder]
  2550.             }
  2551.         } else {
  2552.             if {![htmlIsThereAHomePage] ||
  2553.             [catch {htmlWhichHomePage "update"} hp]} {return}
  2554.             set folder [lindex $hp 0]
  2555.             set files [htmlAllHTMLfiles $folder]
  2556.         }
  2557.         foreach f $files {
  2558.             if {[catch {open $f} fid]} {continue}
  2559.             message "Updating [file tail $f]…"
  2560.             set filecont [read $fid]
  2561.             close $fid
  2562.             regsub -all "\n\r" $filecont "\r" filecont
  2563.             if {[regexp {\n} $filecont]} {
  2564.                 set newln "\n"
  2565.             } else {
  2566.                 set newln "\r"
  2567.             }
  2568.             set linenum 1
  2569.             set newcont ""
  2570.             set ismod 0
  2571.             set errf [string range $f [expr [string length $folder] + 1] end]
  2572.             while {[regexp -nocase -indices $sexpr $filecont res]} {
  2573.                 incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res 0]] {} dummy]
  2574.                 set l [expr 20 - [string length [file tail $f]]]
  2575.                 set ln [expr 5 - [string length $linenum]]
  2576.                 if {![regexp -nocase -indices $eexpr [string range $filecont [lindex $res 1] end] res1]} {
  2577.                     append err  [htmlBrwsErr $errf $l $linenum $ln "Opening include tag without a matching end tag." $f]
  2578.                     break
  2579.                 }
  2580.                 set res1 [list [expr [lindex $res 1] + [lindex $res1 0]] [expr [lindex $res 1] + [lindex $res1 1]]]
  2581.                 if {[regexp -nocase -indices $sexpr [string range $filecont [lindex $res 1] end] res2]
  2582.                 && [expr [lindex $res 1] + [lindex $res2 0]] < [lindex $res1 0]} {
  2583.                     append err  [htmlBrwsErr $errf $l $linenum $ln "Nested include tags." $f]
  2584.                     append newcont [string range $filecont 0 [lindex $res1 1]]
  2585.                     set filecont [string range $filecont [expr [lindex $res1 1] + 1] end]
  2586.                     set linenum [expr [regsub -all $newln $newcont {} dummy] + 1]
  2587.                     continue
  2588.                 }
  2589.                 if {[catch {htmlReadInclude [string range $filecont [lindex $res 0] [lindex $res 1]] 0} text]} {
  2590.                     append err  [htmlBrwsErr $errf $l $linenum $ln $text $f]
  2591.                     append newcont [string range $filecont 0 [lindex $res1 1]]
  2592.                     set filecont [string range $filecont [expr [lindex $res1 1] + 1] end]
  2593.                     set linenum [expr [regsub -all $newln $newcont {} dummy] + 1]
  2594.                     continue
  2595.                 }
  2596.                 lappend modified $f
  2597.                 if {[string trim $text] != [string trim [string range $filecont [expr [lindex $res 1] + 1] [expr [lindex $res1 0] - 1]]]} {
  2598.                     set ismod 1
  2599.                 }
  2600.                 append newcont [string range $filecont 0 [lindex $res 1]]
  2601.                 append newcont $newln $newln $text $newln $newln
  2602.                 append newcont [string range $filecont [lindex $res1 0] [lindex $res1 1]]
  2603.                 set linenum [expr [regsub -all $newln $newcont {} dummy] + 1]
  2604.                 set filecont [string range $filecont [expr [lindex $res1 1] + 1] end]
  2605.             }
  2606.             if {$ismod} {
  2607.                 append newcont $filecont
  2608.                 set linenum 1
  2609.                 if {[regexp -nocase -indices {<!--[ \t\r\n]+#LASTMODIFIED[ \t\r\n]+[^>]+>} $newcont res]} {
  2610.                     incr linenum [regsub -all $newln [string range $newcont 0 [lindex $res 0]] {} dummy]
  2611.                     set l [expr 20 - [string length [file tail $f]]]
  2612.                     set ln [expr 5 - [string length $linenum]]
  2613.                     if {![regexp -nocase -indices {<!--[ \t\r\n]+/#LASTMODIFIED[ \t\r\n]+[^>]+>} [string range $newcont [lindex $res 1] end] res1]} {
  2614.                         append err  [htmlBrwsErr $errf $l $linenum $ln "Opening 'last modified' tag without a matching closing tag." $f]
  2615.                     } else {
  2616.                         set res1 [list [expr [lindex $res 1] + [lindex $res1 0]] [expr [lindex $res 1] + [lindex $res1 1]]]
  2617.                         set str [htmlGetLastMod [string range $newcont [lindex $res 0] [lindex $res 1]]]
  2618.                         if {$str == "0"} {
  2619.                             append err  [htmlBrwsErr $errf $l $linenum $ln "Invalid 'last modified' tags." $f]
  2620.                         } else {
  2621.                             set newcont "[string range $newcont 0 [lindex $res 1]]\r$str\r[string range $newcont [lindex $res1 0] end]"
  2622.                         }
  2623.                     }
  2624.                 }
  2625.                 if {[catch {open $f w} fid]} {
  2626.                     append err "$errf[format "%$l\s" ""]; Could not write update to file. An error occured.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  2627.                 } else {
  2628.                     puts -nonewline $fid $newcont
  2629.                     close $fid
  2630.                 }
  2631.             }
  2632.         }
  2633.     }
  2634.     if {[info exists err]} {
  2635.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight
  2636.         set name [lindex [winNames] 0]
  2637.         changeMode [set winModes($name) Brws]
  2638.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to file)\r\r"
  2639.         insertText $err
  2640.         select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  2641.         setWinInfo dirty 0
  2642.         setWinInfo read-only 1
  2643.         scrollUpLine; scrollUpLine
  2644.     } else {
  2645.         message "$where updated successfully."
  2646.     }
  2647.     if {[info exists modified]} {
  2648.         foreach w [winNames -f] {
  2649.             if {[lsearch -exact $modified [stripNameCount $w]] >= 0} {
  2650.                 if {[askyesno "Update affected windows?"] == "yes"} {
  2651.                     foreach ww [winNames -f] {
  2652.                         if {[lsearch -exact $modified [stripNameCount $ww]] >= 0} {
  2653.                             bringToFront $ww
  2654.                             revert
  2655.                         }
  2656.                     }
  2657.                 }
  2658.                 if {[info exists err]} {bringToFront $name}
  2659.                 return
  2660.             }
  2661.         }
  2662.     }
  2663. }
  2664.  
  2665. # Read content of a file to be included.
  2666. proc htmlReadInclude {incl nr} {
  2667.     if {![regexp -nocase {file=\"([^\"]+)\"} $incl dum fil]} {
  2668.         error "Invalid opening include tag."
  2669.     }
  2670.     set fil [htmlUnQuote $fil]
  2671.     if {![file exists $fil]} {
  2672.         error "File not found."
  2673.     }
  2674.     if {[catch {readFile $fil} text]} {
  2675.         error "Could not read file."
  2676.     }
  2677.     regsub -all "\n\r" $text "\r" text
  2678.     if {$nr} {regsub -all "\n" $text "\r" text}
  2679.     # Remove include tags from inserted text
  2680.     regsub -all -nocase "<!--\[ \t\r\n\]+/?#INCLUDE\[ \t\r\n\]+\[^>\]+>" $text "" text
  2681.     return $text
  2682. }
  2683.  
  2684.